ExcelのVBAで同一フォルダ内にあるファイルに同じ処理をしたい

同一フォルダ内にExcelファイルが400程あります。
この400程のファイルのsheet1からA2からE2をコピーして
ひとつのExcelsheetにその値をまとめたいです。
流れとしては以下になりますが、どのようなコードをマクロに書けば良いでしょうか？

Excelファイル1のsheet1、A2からE2をコピー
ExcelファイルAAA、のA1からE1に貼り付け
Excelファイル1閉じる
Excelファイル2を開く
Excelファイル2のsheet1、A2からE2をコピー
Excelファイルあああ、のA2からE2に貼り付け
Excelファイル2閉じる
Excel3を開く
.........同様の処理を同一フォルダ内の全てのxlsxに実行する

ファイルAAAは既存ファイルとして予め作成して別フォルダに置いてからマクロ実行しても良いですし
マクロ実行時に作成して同一フォルダに保存しても良いです。



お忙しいところ恐縮ですが、教えてくださいませ。
どうぞよろしくお願いします。

No.1 ベストアンサー 回答者： kantansi 回答日時： 2023/09/13 11:00

Excel VBAを使用して、同一フォルダ内の複数のExcelファイルからデータをコピーして統合するマクロを作成できます。

以下は、その手順を示す基本的なコードです。

vba
Copy code
Sub 統合マクロ()
Dim FolderPath As String
Dim Filename As String
Dim MasterWorkbook As Workbook
Dim CurrentWorkbook As Workbook
Dim wsMaster As Worksheet
Dim wsCurrent As Worksheet
Dim LastRow As Long

' マスターファイル（結合先）を開く
Set MasterWorkbook = Workbooks.Open("パス\ファイルAAA.xlsx")
Set wsMaster = MasterWorkbook.Sheets(1)

' 同一フォルダ内のExcelファイルを取得
FolderPath = "フォルダのパス" ' フォルダのパスを指定
Filename = Dir(FolderPath & "\*.xlsx")

' フォルダ内の各Excelファイルを処理
Do While Filename <> ""
' ファイルを開く
Set CurrentWorkbook = Workbooks.Open(FolderPath & "\" & Filename)
Set wsCurrent = CurrentWorkbook.Sheets(1)

' データをコピーしてマスターファイルに貼り付け
LastRow = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row + 1
wsCurrent.Range("A2:E2").Copy wsMaster.Range("A" & LastRow)

' ファイルを保存して閉じる
CurrentWorkbook.Close SaveChanges:=False

' 次のファイルを取得
Filename = Dir
Loop

' マスターファイルを保存して閉じる
MasterWorkbook.Save
MasterWorkbook.Close SaveChanges:=False

' メッセージを表示
MsgBox "統合が完了しました。"
End Sub

このコードは、指定したフォルダ内の全ての.xlsxファイルを処理し、そのファイルのSheet1からA2からE2までのデータをマスターファイル（ファイルAAA）にコピーして統合します。ファイルAAAは事前に用意しておくか、マクロ内で作成することができます。ファイルAAAはマクロを実行するExcelファイルと同じフォルダに保存されます。

コード内のコメントを確認し、必要に応じてフォルダパスやファイル名を適切に設定してください。

No.2 回答者： Andro 回答日時： 2023/09/13 12:00

ExcelのVBAを使用して、同一フォルダ内にあるExcelファイルに同じ処理をする方法を教えます。

以下のコードを使用することで、同一フォルダ内にあるすべてのExcelファイルに対して、sheet1からA2からE2までの範囲をコピーし、新しいExcelファイルに貼り付けることができます。

```vba
Sub CopyData()
Dim MyFolder As String
Dim MyFile As String
Dim wbk As Workbook
Dim ws As Worksheet
Dim DestRow As Long

'処理するフォルダのパスを指定
MyFolder = "C:\Users\user\Desktop\SampleFolder\"

'処理するフォルダ内のすべてのExcelファイルに対して処理を実行
MyFile = Dir(MyFolder & "*.xlsx")
Do While MyFile <> ""
Set wbk = Workbooks.Open(MyFolder & MyFile)
Set ws = wbk.Sheets("Sheet1")
DestRow = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("A2:E2").Copy Destination:=ThisWorkbook.Sheets("Sheet1").Range("A" & DestRow)
wbk.Close False
MyFile = Dir()
Loop
End Sub
```

上記コードでは、`MyFolder`変数に処理するフォルダのパスを指定します。その後、`MyFile`変数に`Dir()`関数を使用して、指定したフォルダ内のすべてのExcelファイル名を取得します。`Do While`ループを使用して、各Excelファイルを開き、`ws.Range("A2:E2").Copy`で範囲をコピーし、新しいExcelファイルに貼り付けます。最後に、元のExcelファイルを閉じます。

このコードを使用する前に、マクロが保存されているExcelファイルと同じフォルダ内に、空のExcelファイル「AAA.xlsx」を作成しておく必要があります。また、このコードは「Sheet1」シートからデータをコピーするように設定されています。必要に応じてシート名や範囲を変更してください。

以上が回答となります。ご参考になれば幸いです。

ソース: Bing との会話 2023/9/13
(1) フォルダ内のxlsxファイルに同一処理をするマクロ【ExcelVBA .... https://vba-create.jp/vba-folder-all-file-process/
(2) フォルダの中にある全てのExcelファイルに同じ処理をするマクロ .... https://officevba.info/fileikkatsushori/
(3) エクセルマクロVBAでフォルダ内のExcelファイル全てに処理をする .... https://www.fastclassinfo.com/entry/do_allexcelf …