「数百のファイルを1つ1つ開くの面倒……」、複数のExcelデータを1箇所に集約するマクロ術：働く価値を上げる“VBA／GAS”術（7）（2/3 ページ）

[高橋宣成，プランノーツ]

経費データ収集マクロ

　フォルダ「経費精算書」内の全ファイルを開き、経費精算データを「経費収集.xlsm」のシート「経費収集」に自動で集めるマクロを作成しました。

Sub 経費データ収集()
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim pass As String
pass = ThisWorkbook.Path & "\経費精算書"
Dim month As Date, department As String, fullname As String '対象月,部署,氏名
Dim i As Long, j As Long '経費精算書の行数,経費集計の行数
j = 2
Dim f As File
For Each f In fso.GetFolder(pass).Files
　　With Workbooks.Open(f)
　　　　With .Worksheets(1)
　　　　　　month = .Range("G1").Value　　  '対象月
　　　　　　department = .Range("G3").Value '部署
　　　　　　fullname = .Range("G4").Value   '氏名
　　　　　　
　　　　　　i = 8
　　　　　　Do While .Cells(i, 1).Value <> ""
　　　　　　　　Sheet1.Cells(j, 1).Value = month　　　　　　　　'対象月
　　　　　　　　Sheet1.Cells(j, 2).Value = .Cells(i, 1).Value   '日付
　　　　　　　　Sheet1.Cells(j, 3).Value = department　　　　   '部署
　　　　　　　　Sheet1.Cells(j, 4).Value = fullname　　　　　　 '氏名
　　　　　　　　Sheet1.Cells(j, 5).Value = .Cells(i, 2).Value   '科目
　　　　　　　　Sheet1.Cells(j, 6).Value = .Cells(i, 5).Value   '摘要
　　　　　　　　Sheet1.Cells(j, 7).Value = .Cells(i, 6).Value   '金額
　　　　　　　　Sheet1.Cells(j, 8).Value = .Cells(i, 7).Value   '備考
　　　　　　　　i = i + 1
　　　　　　　　j = j + 1
　　　　　　Loop
　　　　End With
　　　　.Close
　　End With
Next f
End Sub