VBA

Sub CopyDataFromMultipleFolders()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim folderPaths(1 To 2) As String
Dim fileName As String
Dim filePath As String
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim targetSheet As Worksheet
Dim targetRow As Integer
Dim folderIndex As Integer

' 事前に指定された2つのフォルダのパス
folderPaths(1) = "C:\Path\To\Your\Folder1"
folderPaths(2) = "C:\Path\To\Your\Folder2"

' 対象セルの初期化
targetRow = 1

' フォルダごとに処理を繰り返す
For folderIndex = 1 To 2
' 選択したフォルダ内の全てのエクセルを一つずつ開く
fileName = Dir(folderPaths(folderIndex) & "\*.xls*")

If fileName = "" Then
MsgBox "指定されたフォルダにExcelファイルが見つかりませんでした。", vbExclamation
Exit Sub
End If

' ③ 開いたシート内のC2、C3、I3（またはJ3）セルをコピーして ④ 貼り付け
Do While fileName <> ""
' ファイルのフルパスを取得
filePath = folderPaths(folderIndex) & "\" & fileName

' Excelファイルを開かずにデータをコピー
Set wbSource = Workbooks.Open(filePath, UpdateLinks:=0, ReadOnly:=True)

' 対象となるシートを指定
Set targetSheet = ThisWorkbook.Sheets(folderIndex)

' ターゲットシートにヘッダーを書き込む
If targetRow = 1 Then
targetSheet.Range("A1").Value = "C2"
targetSheet.Range("B1").Value = "C3"
targetSheet.Range("C1").Value = IIf(folderIndex = 1, "I3", "J3")
End If

' 対象セルの値をコピー
For Each wsSource In wbSource.Sheets
targetSheet.Range("A" & targetRow).Value = wsSource.Range("C2").Value
targetSheet.Range("B" & targetRow).Value = wsSource.Range("C3").Value
targetSheet.Range("C" & targetRow).Value = IIf(folderIndex = 1, wsSource.Range("I3").Value, wsSource.Range("J3").Value)

' 次の行に移動
targetRow = targetRow + 1
Next wsSource

' ファイルを閉じる
wbSource.Close SaveChanges:=False

' 次のファイルを取得
fileName = Dir
Loop
Next folderIndex

' 画面更新および警告の表示を再開
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "データのコピーが完了しました。", vbInformation
End Sub

上記のVBAでシート１、2それぞれ貼付けの際にa1セルから順に貼り付けたいのですがどこを修正すればいいでしょうか？

No.1 回答者： zongai 回答日時： 2024/02/04 11:59

' ターゲットシートにヘッダーを書き込む

If targetRow = 1 Then
targetSheet.Range("A1").Value = "C2"
targetSheet.Range("B1").Value = "C3"
targetSheet.Range("C1").Value = IIf(folderIndex = 1, "I3", "J3")
End If

ここが、1行目に対しての処理のようなので、1行目のヘッダーが不要ということであれば、ここの5行の先頭に「'」を付けて実行させないようにするといいかも。