エクセルマクロで、複数ブックの特定シートの特定セルをまとめる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行が何を意味していて、どう動くのかが理解できる!
リンク