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でシート1、2それぞれ貼付けの際にa1セルから順に貼り付けたいのですがどこを修正すればいいでしょうか?
A 回答 (1件)
- 最新から表示
- 回答順に表示
No.1
- 回答日時:
' ターゲットシートにヘッダーを書き込む
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行の先頭に「'」を付けて実行させないようにするといいかも。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 貼り付けた値が消えていく 以下はソースファイルの2番目のシートのB6から最終行を取得 ターゲットファ 2 2023/07/27 12:23
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) VBAが止まります。 2 2022/09/02 14:02
- Excel(エクセル) Excel VBAどこが間違ってますか? 4 2023/07/17 10:04
- Excel(エクセル) Excel データの並び替え 1 2024/01/28 18:11
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) VBAに関して 2 2023/11/09 20:57
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
同じファイル名 上書きしないフ...
-
ファイルサーバ上のファイルが...
-
エクセルで複数のコメントのサ...
-
バッチファイル XCOPYで上書き...
-
MSオフィス2013にMS365が上書き...
-
アクセス クエリを別のファイ...
-
FTPとファイルコピーの違いにつ...
-
Vba初心者です。下記のコード助...
-
4時間
-
ExeclVBAユーザーフォームから...
-
エクセルのハイパーリンクがコ...
-
パワポでスライドをコピーでき...
-
[エクセル]コピーするとオブジ...
-
Delphi6 Labelの表示を切り替える
-
ハイフネーションされている英...
-
frxファイルの役目
-
CDに入っているファイルを別...
-
バッチファイル 別ファイルにリ...
-
読み取り専用でファイルを開きたい
-
vb.net コピーの進捗をプログレ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで複数のコメントのサ...
-
ファイルサーバ上のファイルが...
-
Vba初心者です。下記のコード助...
-
MSオフィス2013にMS365が上書き...
-
同じファイル名 上書きしないフ...
-
バッチファイル XCOPYで上書き...
-
エクセルのハイパーリンクがコ...
-
frxファイルの役目
-
[エクセル]コピーするとオブジ...
-
xcopyでのバッチコピー方法でコ...
-
バッチファイル 別ファイルにリ...
-
bat 同名ファイルコピー時にリ...
-
バッチファイルのコピーで
-
アクセス クエリを別のファイ...
-
vbsでファイルやフォルダのコピ...
-
マインクラフトPCをプレイしよ...
-
エクセル2010、図が大きすぎま...
-
現在のブックを閉じないで、マ...
-
開いている別のファイルにExcel...
-
FTPとファイルコピーの違いにつ...
おすすめ情報

