質問: お世話になります。 ExcelのVBAにて自動化が可能かをご教示ください。 社内の共有フォルダに各営業所から毎日100個ほどのExcelファイルが集められ、 特定のセルの値を別の集約用のExcelに集約しています。 現在はハンドで、ひとつずつのファイルを開き、コピーペーストしております。 これを自動でフォルダ内のすべてのExcelデータを 集約用のExcelファイルへ取り出すことはできないでしょうか。 コロナで人員も減らされている中、 何とか効率的にデータを集計できればと思い、ご相談させて頂きました。 (営業所からのファイル ) 集約したいデータ ・営業所名→D3 ・店名→D4 ・住所 →D6とD7 ・担当者 →D8 ・売上金額→D21 ※ファイル名はそれぞれ異なります。※すべて xlsxファイルです。 ※データが記載されているシート名は「売上報告」です。 (集約用Excel) ・営業所名→A列 ・店名→B列 ・住所 →C列とD列 ・担当者 →E列 ・売上金額→F列 ご教示頂けましたら大変助かります。 どうぞ宜しくお願い致します。
回答: こんなイメージですかね? アレンジはご自分でどうぞ。 Sub Sample() Dim f As String, fld As String Dim sh As Worksheet Application.ScreenUpdating = False '集約フォルダ fld = "D:\test" f = Dir(fld & "\*.xlsx") If f = "" Then Exit Sub Do While f <> "" On Error Resume Next Set sh = Workbooks.Open(fld & "\" & f, ReadOnly:=True).Sheets("売上報告") If Err.Number = 9 Then Err.Clear Else With ThisWorkbook.Sheets("集約シート").Cells(Rows.Count, "A").End(xlUp) .Offset(1, 0).Value = sh.Range("D3").Value .Offset(1, 1).Value = sh.Range("D4").Value .Offset(1, 2).Value = sh.Range("D6").Value & sh.Range("D7").Value .Offset(1, 3).Value = sh.Range("D8").Value .Offset(1, 4).Value = sh.Range("D21").Value End With End If Workbooks(f).Close False On Error GoTo 0 f = Dir() Loop Application.ScreenUpdating = True MsgBox "Done." End Sub