メンテナンス性や実行時間を改善――複数のExcelデータを1箇所に集約するマクロの別解とは：働く価値を上げる“VBA／GAS”術（9）（1/3 ページ）

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