【エクセルマクロ】複数ファイルの特定セルを転記：自動化

エクセルマクロで、複数ブックの特定セルをまとめるVBAコードをご紹介します。

このページのマクロコードは、コピペで使えます。
ぜひお試しください！

複数ファイルの特定セルを転記

以下のExcelVBAを実行すると、複数のファイルから特定セルを1つのファイルに抽出します。

Sub 指定フォルダ内のブックから特定セルをコピペ()

Dim path, fso, file, files
Dim Wb, Buf As Workbook
Dim Target, MyList As Variant
Dim i, j, Q, MyRow As Long

    'マクロファイルを変数格納
    Set Wb = ActiveWorkbook

    Target = Array("売上", "利益", "経費")

    '読み取るファイル格納先
    path = "C:\Users\admin\Desktop\テスト"

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set files = fso.GetFolder(path).files

    Application.ScreenUpdating = False

        'フォルダ内の全ファイルについて処理
        For Each file In files

            'エクセルファイルだったら処理を進める
            If fso.GetExtensionName(file) = "xlsx" Then

                'エクセルファイルを開いて、変数格納
                Workbooks.Open (file)
                Set Buf = ActiveWorkbook

                '開いたファイルのデータを配列格納
                MyList = Buf.ActiveSheet.Range(Cells(1, 1), Cells(5, 2))

                Wb.Activate

                '「Target」ループ
                For i = 0 To UBound(Target)
                
                    With Wb.ActiveSheet

                        '「Target」検索し、該当行を取得
                        MyRow = .Cells.Find(What:=Target(i), After:=Range("A1")).Row
    
                        '該当行から最終行までループ
                        For j = MyRow To .Cells(Rows.Count, 1).End(xlUp).Row
    
                            '開いたファイルのセルA1と同じ果物名だったら
                            If .Cells(j, 1) = MyList(1, 1) Then
    
                                '開いたファイルの1～5行目までループ
                                For Q = 1 To 5
    
                                    '配列から「Target」を探す
                                    If MyList(Q, 1) = Target(i) Then
    
                                        '該当内容を転記
                                        .Cells(j, 2) = MyList(Q, 2)
                                        GoTo MyJump
    
                                    End If
                                Next Q
                            End If
                        Next j
MyJump:
                    End With
                Next i
            End If
            
            '開いたエクセルファイルを保存せず閉じる
            Application.DisplayAlerts = False
            Buf.Close
            Application.DisplayAlerts = True
        Next file

    Application.ScreenUpdating = True

End Sub

マクロ実行前

上記のマクロコードを組んだエクセルファイルを準備します。

[path = “C:\Users\admin\Desktop\テスト”] に、エクセルファイルを格納します。

各エクセルファイルのフォーマットは統一されています。

マクロ実行後

フォルダ内にある全てのExcelファイルから、指定項目の値を抜き出して、

1つのエクセルファイルに転記します。

 
 
この記事がお役に立ちますと幸いです。
 

【エクセルマクロ】別シート転記(抽出)を自動化する：超便利20選

...

kirinote.com

2023.02.04