VBA 複数ファイルの特定シートの特定セルを転記(動画あり)

VBA-複数ファイルの特定シート特定セルを転記-アイキャッチ ExcelVBA

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

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

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

以下のExcelVBAを実行すると、複数のファイルから1つのファイルに値を転記します。


Sub フォルダ内のエクセルから特定セルを抽出()

Dim path, fso, file, files
Dim Wb As Workbook
Dim LastRow_Wb As Long
Dim Ws As Worksheet
Dim i As Long

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

    '読み取るブック格納先
    path = "C:\Users\admin\Desktop\テスト"

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

    '貼り付け開始位置
    LastRow_Wb = 1

    Application.ScreenUpdating = False

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

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

                'エクセルファイルを開く
                Workbooks.Open (file)
                
                '全シートループ
                For Each Ws In Worksheets
                
                    'シート名が「リスト」だったら
                    If Ws.Name = "リスト" Then
                    
                        '1~最終行までループ
                        For i = 1 To Ws.Cells(Rows.Count, 1).End(xlUp).Row
                        
                            'セル値が「2020年」だったら
                            If Ws.Cells(i, 1) = "2020年" Then
                            
                                '指定セルコピー
                                Ws.Range(Cells(i, 1), Cells(i, 4)).Copy Wb.ActiveSheet.Cells(LastRow_Wb, 1)
                                'E列にファイル名転記
                                Wb.ActiveSheet.Cells(LastRow_Wb, 5) = file.Name
                                '貼り付け開始位置を変更
                                LastRow_Wb = LastRow_Wb + 1
                                'ジャンプ
                                GoTo MyJump
                            End If
                        Next i
                    End If
                Next Ws
MyJump:
                '開いたエクセルファイルを保存せず閉じる
                Application.DisplayAlerts = False
                ActiveWindow.Close
                Application.DisplayAlerts = True
            End If
        Next file

    Application.ScreenUpdating = True

End Sub

マクロ実行前

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


 

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


 

各エクセルファイルの「リスト」シートの「2020年」の行を、別ファイルに転記します。

「リスト」シートが存在しない場合は、なにもしないで該当ファイルを閉じます。

「2020年」の行の位置がファイル毎に異なります。


 

マクロ実行後

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

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


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

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

 

「スラスラ読める Excel VBA ふりがなプログラミング」
究極のやさしさを目指した、まったく新しいVBAの入門書
マクロの1行1行が何を意味していて、どう動くのかが理解できる!