【VBA】フォルダ内のブックから必要なものだけを順に別ブックにコピーしていく方法

マスタを更新する作業ってありませんか?
これは何月のマスタとか、これは○○でとか、同じようなものを毎回いろんなブックにコピーしていかないといけないことがあります。

これを解消できないか考えたマクロです。(パワークエリに近いかな)

スポンサーリンク

フォルダ内のブックをまとめて処理

Option Explicit
Sub test()
Application.ScreenUpdating = False

Dim a, b
Dim WB As Workbook
Dim buf As String
Dim folderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
        folderPath = .SelectedItems(1)
        End If
    End With
    
    'Dir関数でファイルを確認
    buf = Dir(folderPath & "\*.xls")
    
    'フォルダ内にブックがなければ終了
    If buf = "" Then Exit Sub
    
    Do
    
    If buf Like "*○○*" Then
        'ブック名に○○が含まれて場合に挙動
        Set WB = Workbooks.Open(Filename:=folderPath & "\" & buf)
        Workbooks("Book").Worksheets("○○").UsedRange.ClearContents
        Set b = Workbooks("Book").Worksheets("○○").Range("A1")
        WB.Close

    End If
    
     If buf Like "*△△*" Then
        'ブック名に△△が含まれて場合に挙動
        Set WB = Workbooks.Open(Filename:=folderPath & "\" & buf)
        Workbooks("Book").Worksheets("△△").UsedRange.ClearContents
        Set b = Workbooks("Book").Worksheets("△△").Range("A1")
        WB.Close

    End If
        
        '次のブックのファイル名を取得
        buf = Dir()
    Loop While buf <> ""

 Application.ScreenUpdating = true
   
End Sub

条件分岐はSelectのほうが簡単そうですが、likeが使いずらいのでIfでやっています。
条件分岐後はクラスモジュールを利用すると見栄えがいいと思います

スポンサーリンク

解説的なもの

Application.ScreenUpdating

画面を止めておくやつです。
どっちでもいいと思います。

お好みで止めてください。

フォルダのパスを取得

With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
        folderPath = .SelectedItems(1)
        End If
    End With

この部分でフォルダパスを取得しています。
ダイアログを開いて利用者に選ばせる方法です。

これがあるとないので、あとからのクレームを防げるので必須だと思います。
フォルダ名変わったとかでエラーを起こして文句言われること多いですからね。

Dir関数

Dir関数は、ファイルが存在するかどうかを判定する関数なんですが、引数を省略すると、まだ返していないファイル名を順に返すという特性があります。

buf = Dir(folderPath & “\*.xls”)で一度指定して返すと、以降はbuf = Dir()これだけで、同じフォルダ内でまだ返していないファイルを順番に返してくれるのです。

おわり

コピーなどは

こちらを利用しています。

自由コメント 登録不要です!

タイトルとURLをコピーしました