[[20190612140328]] 『VBA セルの値をフォルダ内の他ブックへ値貼付けし』(初心者) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBA セルの値をフォルダ内の他ブックへ値貼付けしたい』(初心者)

マクロ初心者です。
下記を行うVBAメソッドが上手くいきません。
まだまだ解らない点も多く…
ご教示いただけないでしょうか?

【状況】

TESTというフォルダに

0.xlsm
あ.xlsm
い.xlsm
う.xlsm
え.xlsm
お.xlsm

上記、同じ仕様の6つのブックがあります。

【行いたい事】
1つ目:
0.xlsmブックのシート1のA1セルとC1セルの値を
フォルダ内全ての、他ブックの
一番左のシートの同じセルへ値貼付けする。

2つ目:
貼付け後、0.xlsmブック以外の
他ブックの一番左のシートのみ印刷する。

3つ目:
フォルダ内全てのファイルを上書き保存して閉じる。

申し訳ありませんが、よろしくお願いいたします。

< 使用 Excel:Excel2007、使用 OS:Windows8 >


 >>下記を行うVBAメソッドが上手くいきません。
なんていうメソッドですか?
出来れば個人情報がもしあれば、名称等、変えて
コードをアップすれば、たくさん、アドバイスが
ありますよ。。。きっと。。。 m(_ _)m
(隠居じーさん) 2019/06/12(水) 15:38

(隠居じーさん)様

ご指摘いただきありがとうございます。
動くようなメソッドまでたどり着いたのですが
全シート印刷されてしまいます。
一番左のシートのみを印刷させる方法はありますでしょうか?
(シート名は統一することも可能ですが統一させない方法があればそちらが希望です。)

また、下記メソッドより良い方法はありますでしょうか?

ご教示いただけると助かります。


Sub TEST()
'
 Dim fileName As String
 Dim wsName As String: wsName = "TEST" 

 Application.ScreenUpdating = False 
 Application.DisplayAlerts = False 
 ChDir ThisWorkbook.Path
 fileName = Dir("*.xls?") 
 Do While fileName <> ""
 If fileName <> ThisWorkbook.Name Then 
 With Workbooks.Open(fileName) 

 ThisWorkbook.Worksheets(wsName).Range("A1").Copy .Worksheets(wsName).Range("A1")

 ThisWorkbook.Worksheets(wsName).Range("C1").Copy .Worksheets(wsName).Range("C1")

 .Worksheets(wsName).Range("A1").Select
 .PrintOut
 .Close savechanges:=True

End With

 End If
 fileName = Dir() 
Loop
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True

 End Sub


よろしくお願いいたします。

(初心者) 2019/06/13(木) 13:22


 .PrintOut
 ↓
 .Worksheets(1).PrintOut

 ワークシートには左から順にインデックス番号というものが振られていて、
 Worksheets(1)は、インデックス番号が1番のもの(=左から1番目)という意味です(^^)

(虎) 2019/06/13(木) 14:04


 虎 さん からご説明もあったようですが。私の勉強のため作ってみました。
きっともっとスマートな方法は有るかもしれませんが、何かの足しにでも。 A^^;
 Option Explicit
Sub OneInstance()
    Const BBName As String = "0.xlsm"
    Dim TB As Workbook
    Dim WB As Workbook
    Dim Fnm As String
    Set TB = Workbooks(BBName)
    Fnm = Dir(TB.Path & "\" & "*.xls*")
    Do Until Fnm = ""
        If Fnm <> TB.Name Then
            Set WB = Workbooks.Open(TB.Path & "\" & Fnm)
            With WB.Worksheets(1)
                .Range("A1").Resize(, 3) = TB.Worksheets("シート1").Range("A1").Resize(, 3).Value
                .PrintPreview
            End With
            WB.Close True
            Set WB = Nothing
        End If
        DoEvents
        Fnm = Dir()
    Loop
    Set TB = Nothing
End Sub
(隠居じーさん) 2019/06/13(木) 14:50

 お!いけない。。。  すみません。。。
>>0.xlsmブックのシート1のA1セルとC1セルの値を
だったので 0.xlsmのシートは シート1 にしました
TEST だったのですね ^^;
テキトーに環境に合わせて下さいね。( ̄▽ ̄)
読込BOOKの方は全て左端のシートです。
でわ
m(_ _)m
(隠居じーさん) 2019/06/13(木) 14:59

(虎)様
(隠居じーさん)様

ご返信が遅くなりまして申し訳ありません。
お教えいただきありがとうございました。

もしよろしければ、もう1点お教えいただきたいです。
こちらのブックをネットワークフォルダに
保存した場合の開くメソッドもお教えいただけないでしょうか?

↓現状↓

Sub TEST()
'

 Dim fileName As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
ChDir ThisWorkbook.Path

 fileName = Dir("*.xls?")Do While fileName <> ""
 If fileName <> ThisWorkbook.Name Then
With Workbooks.Open(fileName)

ThisWorkbook.Worksheets(1).Range("A1").Copy .Worksheets(1).Range("A1")

ThisWorkbook.Worksheets(1).Range("C1").Copy .Worksheets(1).Range("C1")

 .Worksheets(1).Range("A1").Select
 .Worksheets(1).PrintOut
 .Close savechanges:=True
End With
 End If
 fileName = Dir()
Loop
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True

 End Sub

申し訳ありませんが、よろしくお願いいたします。

(初心者) 2019/06/18(火) 15:19


 >こちらのブックをネットワークフォルダに 
保存した場合の開くメソッドもお教えいただけないでしょうか?

 ↑の『こちらのブック』とは、最初の説明にあった『0.xlsm』のブックでしょうか?
 『0.xlsm』ブックを『TEST』という名前のフォルダからネットワークフォルダに移動させたとき、
 『TEST』フォルダにある他のブックをどうやって開けばいいのか?ということでしょうか?

(虎) 2019/06/18(火) 16:40


いまNET、なにもつながっていなくてテスト出来ません
下記の様な事でも出来なくは無いかと。。。^^;
昔の事で。。。すみません。。かなり失念致しております。m(_ _)m

WSH(Windows Scripting Host)などで
net use \\pc_Name /user:User_Name Password
実行

vbaです ^^;
Workbooks.Open("\\pc_Name\D\TEST\0.xlsm")

WSH(Windows Scripting Host)などで

net use \\pc_Name /delete
実行
使用オブジェクトの後始末。。。

ネットに接続されていれば最初と、最後は要らないかもですね。
なお、WSHとかDOSコマンドに関してはお詳しい方の回答を
お待ちください。ヒントだけみたいな事で済みません。
(隠居じーさん) 2019/06/18(火) 17:18


虎様

ご返信が遅くなり申し訳ありません。
0、あ〜お.xlsmのブックの入っている
TESTフォルダごとネットワークフォルダへ移動させ
ネットワークフォルダの中のTESTフォルダ内にある
0.xlsmブックでVBAを実行したら、
あ〜お.xlsmのブックへ指定セルがコピペされ
上書き保存して、印刷して閉じる。
という形にしたいです。

隠居じーさん様

ヒントをいただきありがとうございます。
参考にして考えてみます。

(初心者) 2019/06/21(金) 06:08


横からですけど
>TESTフォルダごとネットワークフォルダへ移動させ
>ネットワークフォルダの中のTESTフォルダ内にある
普通に、ThisWorkbook.Pathで拾えませんでしたっけ?

(初心者) 2019/06/13(木) 13:22 のコードをちょっと整理すると↓のようになるとおもいますが、どの部分かでエラーでちゃいますか?

    Sub TEST_改()

        Dim fileName As String
        Dim MySH As Worksheet
        Set MySH = Worksheets(1)

        fileName = Dir(ThisWorkbook.Path & "*.xls?")

        Do Until fileName = ""
            If fileName <> ThisWorkbook.Name Then
                With Workbooks.Open(ThisWorkbook.Path & fileName)

                    '▼コピー
                    MySH.Range("A1").Copy .Worksheets(1).Range("A1")
                    MySH.Range("C1").Copy .Worksheets(1).Range("C1")

                    '▼プリントアウト
                    .Worksheets(1).PrintOut

                    '▼上書保存
                    .Save

                    '▼閉じる
                    .Close

            End With

            fileName = Dir()
        Loop

    End Sub

しいて言えば、する必要ない「ChDir」しているのが問題だったかも・・・
(ファイル階層が深い場合の対応だったとしても別のアプローチがあるとおもいます)

(もこな2) 2019/06/21(金) 06:48


↑で「End If」を忘れてました。

    Sub TEST_改修正()

        Dim fileName As String
        Dim MySH As Worksheet
        Set MySH = Worksheets(1)

        fileName = Dir(ThisWorkbook.Path & "*.xls?")

        Do Until fileName = ""
            If fileName <> ThisWorkbook.Name Then
                With Workbooks.Open(ThisWorkbook.Path & fileName)

                    '▼コピー
                    MySH.Range("A1").Copy .Worksheets(1).Range("A1")
                    MySH.Range("C1").Copy .Worksheets(1).Range("C1")

                    '▼プリントアウト
                    .Worksheets(1).PrintOut

                    '▼上書保存
                    .Save

                    '▼閉じる
                    .Close

                End With
            End If

            fileName = Dir()
        Loop

    End Sub

※コンパイルは通るように修正しましたが、実行テストまではしていないので他にもミスがあるかもしれません。

(もこな2) 2019/06/21(金) 07:14


 すでにもこな2さんからコメントいただいている通り、『0.xlsm』ファイルとその他のファイルが
 同じ場所(フォルダ)にある場合、元のコードで特に問題ないのかな?と思います(^^)

 もしもエラーが発生するようであれば、エラーが発生する場所とエラーの内容を教えてもらえると、
 いいかと思います。

(虎) 2019/06/21(金) 08:34


質問者さんからのレスがないですが、↓みたいにDir関数で対応出来ない場合は、FileSystemObjectを使ってみるとよいとおもいます。
https://excel-ubara.com/excelvba4/EXCEL262.html
    Sub さんぷる()
        Dim FSO As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Dim MyFile As Object

        For Each MyFile In FSO.GetFolder(ThisWorkbook.Path).Files
            Debug.Print MyFile.Name
        Next

    End Sub

(もこな2) 2019/06/24(月) 18:27


少しこちらの業務より離れておりましたので
ご返信が遅くなり申し訳ありませんでした。
皆さま、様々な方法でご考案いただきありがとうございます。

虎様よりご質問いただいたエラー箇所の件ですが。
元のコードでも、もこな2様がお作りいただいたコードでも
エラーは発生しませんが、コピペも上書き保存も印刷も実行されない。
という状況です。

ネットワークフォルダへ入れた場合のみ上記の実行不可となります。
どなたか原因がわかる方いらっしゃいますでしょうか?
(初心者) 2019/06/28(金) 08:30


>コピペも上書き保存も印刷も実行されない。
という状況です。
ちゃんとステップ実行してみましたか?
まだなら、とりあえずそこからでしょう。

(もこな2) 2019/06/28(金) 08:50


 もう一度確認させてください。
 『0.xlsm』ブックと他のブックは同じフォルダ内の同じ階層にあるんですよね?
 同じフォルダ内だけど、実は階層が違うよってことはないですよね?
 『0.xlsm』ブックの場所は、
   ネットワークフォルダ
   →0.xlsm
 だけど、他のブックの場所は、
   ネットワークフォルダ
   →別のフォルダ
    →他のブック
    →他のブック
    →他のブック
 とかではないですよね?という確認です。
 伝わるかなぁ…。 文字だけで伝えようとすると難しいですね(^^;

 なんとなくですが、そもそもブックを開くことに失敗しているような気がします…。
 まずはステップ実行で、
 >With Workbooks.Open(fileName)
 の部分でちゃんと他のブックが開かれるかを確認していただけたらと思います。

(虎) 2019/06/28(金) 09:05


虎様

早速ご回答いただきありがとうございます。
ネットワーク上にある
TESTフォルダ内に
0.xlsm
あ.xlsm
い.xlsm
う.xlsm
え.xlsm
お.xlsm

が存在しています。
マクロ実行ファイルは0ブックです。

虎様へお教えいただいた通りステップ実行しましたら
ご回答いただいた通り、他のブックは開かれず
フォルダの画面へ切り替わるのみでした。

(初心者) 2019/06/28(金) 09:29


 やっぱりおんなじ場所なんですよねぇ…。

 とりあえず、そこにマクロ有効ブック(.xlsmブック)を新規で作ってもらって、
 標準モジュールに↓のコードを貼り付けて実行してもらったとき、シート1に
 『0.xlsm』〜『お.xlsm』ブックまでの名前がちゃんと出てくるか確認してもらえますか?
 たぶんDirがうまくいってないと思うので…。

 Option Explicit

Sub test()

    Dim fname As String

    fname = Dir(ThisWorkbook.Path & "\" & "*.xls?")
    Do Until fname = ""
        ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = _
            fname
        fname = Dir()
    Loop

End Sub

 これでうまくすべてのブックの名前を取れているなら、
 >fileName = Dir("*.xls?")Do While fileName <> ""
 ここのDir(〜)までを↑のコードのDir(〜)に差し替えてもう一度トライしてみてください。
 逆に↑のコードでブック名が取れないと、自分にはちょっとわからないかもしれないです…orz

(虎) 2019/06/28(金) 09:50


>フォルダの画面へ切り替わるのみでした。
↑が理解できないですけどこういうことじゃないですかね

 (1)ネットワークフォルダのフォルダパスとファイル名を組み合わせた【フルパス】が
   ↓みたいな感じになって256バイト(半角英数に換算して256文字を超えている
   \\File_Server\○○部\××課\■■プロジェクト\▲▲から引継ぎ〜〜〜\あ.xlsm

 (2)Dir関数が
   Dir(256バイトを超えるパス) となり、「""」を返す
   (※ちょっと、ここ怪しいです。エラーになって何も格納されないから""のままなのかも・・) 

 (3)Do 〜 Loop で
  「Do Until fileName = ""」なので、中身を実行する前に条件を満たしたと判定され
   中身の部分はそっくり実行されなくなる。

 (4)↑についてステップ実行すれば、どういう原因か(ループの中身が実行されていないこと)は
  直ぐわかるけど、やらないから解らない 【←今ココ】

ステップ実行していて、)Dir関数の戻り値が""じゃないのは確認済みということであれば、予想外れごめんなさい。
違ってた場合は私には他に原因わからないし、合ってたとしても話をきいてもらえなさそなので撤退します。
(一応、フルパスが256バイトを超える場合の対処法は書いたつもりです。原因が推測通りであったら気が向いたときにでも試してみてください)

(もこな2) 2019/06/28(金) 10:27


虎様

ご教示いただいた通り新規ブック(ブック名:TEST)へ
上記コードを貼付け実行したところ、
シート1へTEST,0,あ〜おのブック名がセルへ入力されました。
その為、Dir(〜)を変更して下記コードにて実行しましたが
エラーが発生します。

発生箇所は
With Workbooks.Open(fileName)
でした。

========================================================================================
Sub TEST()

 ' 

 Dim fileName As String

Application.ScreenUpdating = False

 Application.DisplayAlerts = False 
 ChDir ThisWorkbook.Path 

 fileName = Dir("*.xls?") 
 Do While fileName <> ""

 If fileName <> ThisWorkbook.Name Then
With Workbooks.Open(fileName) '←エラー発生箇所

ThisWorkbook.Worksheets(1).Range("A1").Copy .Worksheets(1).Range("A1")

ThisWorkbook.Worksheets(1).Range("C1").Copy .Worksheets(1).Range("C1")

 .Worksheets(1).Range("A1").Select
 .Worksheets(1).PrintOut
 .Close savechanges:=True
End With
 End If
 fileName = Dir()
Loop
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True

 End Sub

========================================================================================

捉え方が間違っておりましたら申し訳ありません。

(初心者) 2019/06/28(金) 10:42


もこな2様

ご回答ありがとうございます。
TESTフォルダまでのバイト数を確認したところ
152バイトでした。
また、虎様にお教えいただいたコードで
シート1へファイル名の記述ができたということは
Dir(〜)で問題ないという事でしょうか?

多々知識不足で申し訳ありません。
(初心者) 2019/06/28(金) 10:47


 Sub TEST()

    Dim fileName As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ChDir ThisWorkbook.Path '←これいらなくなります

    fileName = Dir("*.xls?") '←※ここを変えてください※ Dir("*.xls?")→Dir(ThisWorkbook.Path & "\" & "*.xls?")
    Do While fileName <> ""
        If fileName <> ThisWorkbook.Name Then
            With Workbooks.Open(fileName)
                ThisWorkbook.Worksheets(1).Range("A1").Copy .Worksheets(1).Range("A1")
                ThisWorkbook.Worksheets(1).Range("C1").Copy .Worksheets(1).Range("C1")
                .Worksheets(1).Range("A1").Select
                .Worksheets(1).PrintOut
                .Close savechanges:=True
            End With
        End If
        fileName = Dir()
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

 なんかあとから読み返すと自分の説明だいぶわかりにくかったですね(^^;
 勘違いさせてしまってすみません…m(_ _)m

 ↑のコードにコメントを付けた個所を変更してください。

(虎) 2019/06/28(金) 10:59


 すみません…。 ↑の(虎) 2019/06/28(金) 10:59のコード↓に差し替えてくださいm(_ _)m

 Sub TEST()

    Dim fileName As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ChDir ThisWorkbook.Path '←これいらなくなります

    fileName = Dir("*.xls?") '←※ここを変えてください※ Dir("*.xls?")→Dir(ThisWorkbook.Path & "\" & "*.xls?")
    Do While fileName <> ""
        If fileName <> ThisWorkbook.Name Then
            With Workbooks.Open(fileName) '←※ここを変えてください※ With Workbooks.Open(fileName)→With Workbooks.Open(Thisworkbook.Path & "\" & fileName)
                ThisWorkbook.Worksheets(1).Range("A1").Copy .Worksheets(1).Range("A1")
                ThisWorkbook.Worksheets(1).Range("C1").Copy .Worksheets(1).Range("C1")
                .Worksheets(1).Range("A1").Select
                .Worksheets(1).PrintOut
                .Close savechanges:=True
            End With
        End If
        fileName = Dir()
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

(虎) 2019/06/28(金) 11:22


 ちなみに、コメント通りに直してもらうと、もこな2さんの(もこな2) 2019/06/21(金) 07:14の
 コードとほぼ同じになります。
 じゃあ、なんでもこな2さんのコードで動かなかったんだろう?ってところなのですが、
 たぶん、
 >With Workbooks.Open(ThisWorkbook.Path & fileName)
 のところの、"\"を忘れてるからかなぁ…(^^;

(虎) 2019/06/28(金) 11:39


虎様

申し訳ありません。
私のコードの記述が間違っておりました。
訂正したコードで実行しましたが
エラーにはなりませんが、また何も実行されずに終わりました。

下記、実行コードです。

========================================================================================

 Sub TEST()

    Dim fileName As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    fileName = Dir(ThisWorkbook.Path & "\" & "*.xls?")
    Do While fileName <> ""
        If fileName <> ThisWorkbook.Name Then
            With Workbooks.Open(Thisworkbook.Path & "\" & fileName)
                ThisWorkbook.Worksheets(1).Range("A1").Copy .Worksheets(1).Range("A1")
                ThisWorkbook.Worksheets(1).Range("C1").Copy .Worksheets(1).Range("C1")
                .Worksheets(1).Range("A1").Select
                .Worksheets(1).PrintOut
                .Close savechanges:=True
            End With
        End If
        fileName = Dir()
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

========================================================================================

ネットワークフォルダでなくても実行されませんでした。
度々申し訳ありません。

(初心者) 2019/06/28(金) 11:55


撤退するといったけど、返答もらったので一応。
>TESTフォルダまでのバイト数
言ってるのはファイルサイズのバイトではなく文字数のことだけど、伝わってますか?
 [ABCDEF]・・・・・6バイトの文字列
 [あいう]・・・・・6バイトの文字列(全角1文字は2バイト)

なので「ThisWorkbook.Path & "あ.xlsm"」が半角英数に換算して256文字を超えてないか というのが確認している点です。
Dir関数は、(半角英数換算で)256以上の【フルパス】を与えられても、うまく動作しないので、フォルダパス + ファイル名 で構成される【フルパス】が(半角英数換算で)256文字を超えるとマズイですと言っています。

したがって、フルパスの文字長が本当に152バイトなら私の想像は大外れなので無視してください。
ちなみに、「あ.xlsm」ブックを開いてアクティブにしてから、イミディエイトに「?LenB(ActiveWorkbook.fullname)」と入力すると、何バイト長なのか簡単に調べることが出来ます。

(もこな2) 2019/06/28(金) 12:00


 こちらでは初心者さんが直してくれたコードでうごいてるんですよねぇ…なんでだろう?
 ちょっと原因がわからないです…orz

(虎) 2019/06/28(金) 12:15


もこな2様

分からなくて申し訳ありません。
イミディエイトウィンドウへ
「?LenB(ActiveWorkbook.fullname)」を入力してみたのですが
バイト数はどこに表示されますでしょうか?

一応バイト数を調べるサイトで
フォルダまでの文字を入れて確認してみたのですが…。
こちらの確認の仕方では異なりますか?
(初心者) 2019/06/28(金) 12:22


 >0、あ〜お.xlsmのブックの入っている 
 >TESTフォルダごとネットワークフォルダへ移動させ 

(初心者) 2019/06/28(金) 11:55

 のコードの

 1)
 >fileName = Dir(ThisWorkbook.Path & "\" & "*.xls?")
 を
 CreateObject("WScript.Shell").CurrentDirectory = "\\何とか\かんとか\"
 fileName = Dir("*.xls?")

 "\\何とか\かんとか\"を実際のネットワークパスに変更。

 2)
 >With Workbooks.Open(Thisworkbook.Path & "\" & fileName)
 を
 With Workbooks.Open(fileName)

 に変更して試しててください。

(seiya) 2019/06/28(金) 12:46


With Workbooks.Open(ThisWorkbook.Path & fileName)
のところの、"\"を忘れてるからかなぁ…(^^; あっほんとうだ。ご指摘ありがとうございます。
やっぱりテストしないとダメですね・・・

>イミディエイトウィンドウへ
>「?LenB(ActiveWorkbook.fullname)」を入力してみたのですが
>バイト数はどこに表示されますでしょうか?
イミディエイトはどうなってますか?
言ったとおり、ネットワークドライブ上にある「あ.xlsm」を開いてアクティブにしてから
イミディエイトに「?LenB(ActiveWorkbook.fullname)」を入力してみたら

 ?LenB(ActiveWorkbook.fullname)
 152

って表示されたなら、仰るとおり「あ.xlsm」のプルパスの長さは152バイトで合ってます。

ただ、(初心者) 2019/06/28(金) 11:55のコードでは私のミスは直したうえで
” 何も実行されずに終わりました”とのことなので、私には原因はわかりません。
(「ステップ実行したら、Do While〜 からloopまで一気に飛んじゃいます」だったらとりあえずの原因は解りますが。)

(もこな2) 2019/06/28(金) 12:49


皆さま申し訳ありません。
私の実行していたコードに一部誤りがあったようです。
(一部分ずつ変えながら実行していました。)

こちらのコードを貼りなおして実行しましたら
ネットワークフォルダでもできました。

ご迷惑をおかけし申し訳ありませんでした。

ちなみにもこな2様にお教えいただいた方法で確認しましたら
バイト数は236でした…。
全然異なっておりました。すみませんでした。

下記コードで解決しました。
=====================================================================================

 Sub TEST()

    Dim fileName As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    fileName = Dir(ThisWorkbook.Path & "\" & "*.xls?")
    Do While fileName <> ""
        If fileName <> ThisWorkbook.Name Then
            With Workbooks.Open(Thisworkbook.Path & "\" & fileName)
                ThisWorkbook.Worksheets(1).Range("A1").Copy .Worksheets(1).Range("A1")
                ThisWorkbook.Worksheets(1).Range("C1").Copy .Worksheets(1).Range("C1")
                .Worksheets(1).Range("A1").Select
                .Worksheets(1).PrintOut
                .Close savechanges:=True
            End With
        End If
        fileName = Dir()
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub
=====================================================================================

記述間違えが無いよう、以後気を付けます。
ご対応ありがとうございました。

(初心者) 2019/06/28(金) 13:25


 あぁ、よかった(^^)
 お疲れ様でした♪

(虎) 2019/06/28(金) 13:52


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.