エクセルで別ファイルのシートの貼り付けマクロ

質問

マクロ初心者です。よろしくお願いします。
exｃelファイルのシートに同じシート名csvファイルのデーターの貼り付けをしたいのです。

↓詳しくは。

exｃelファイルがあります。（ファイル名：全社）
シート名＝集計、１、２、３、４、５、６、７、８、９、１０（固定）

csvファイルがあります。１～始まり数は変動（１～３だったり、１～７とか）
１ファイル＝１シート、ファイル名とシート名は同じ

exｃelファイルのシート（１～１０）に、開いたｃｓｖファイルの同じシート名（１～１０）のデータを貼り付けたい。

毎回コピー・貼り付けの繰り返し作業なので、マクロ作成を試しているのですが、うまくいきません。
教えてください。お願いします。

回答No.2

snowsan062

複数のCSVをコピーしたいとの事なので
どこかのフォルダにCSVを入れると仮定して作ってます。
フォルダのパスってのは、CSVを入れてるフォルダのパスの事です。

フォルダのパスって単語自体わからないのであれば
画像を添付しているんで、それを確認して下さい。
もしくは、全社.xlsと同じフォルダにCSVを入れた状態で
strPath = Worksheets("集計").Range("B2") ' ★1
を
strPath = ThisWorkbook.Path ' ★1
に変えて下さい。とりあえず動きます。
（全社.xlsと同じ所にあるCSVをコピーしますよって事です）

strPath = Worksheets("集計").Range("B2") ' ★1
ではなくて
strPath = "C:\Users\はじめまして！\Desktop\新しいフォルダ (3)" ' ★1
とかの方がわかりやすかったかもしれんね。

お礼

早々のご回答ありがとうございました。
初歩的な質問にもかかわらず、画像までつけていただき
理想どおりの回答で、感動しております。
また機会がありましたら、宜しくお願いします。

回答No.1

snowsan062

こんな感じでどう？

以下の部分は修正して
★1　フォルダのパスを指定するセルに変える。サンプルだと集計シートのセルB2
★2　貼り付けたいシートの分だけ書く（今回の名前が本物かどうかわからなかったので）
★3　コピーする範囲や方法が異なる場合はここを直す
　　 直す場合は、マクロの記録で実際にやってそれを利用すればいいと思う。

Sub test()
Dim objFSO As Object
Dim objLp As Object
Dim objDic As Object
Dim wsCopy As Worksheet
Dim wsPaste As Worksheet
Dim strPath As String

Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")

If vbNo = MsgBox("実行しますか？", vbInformation + vbYesNo, "確認") Then
GoTo test_End
End If

' フォルダの存在チェック
strPath = Worksheets("集計").Range("B2") ' ★1
If Not (objFSO.FolderExists(strPath)) Or strPath = "" Then
Call MsgBox("読み取るフォルダのパスが正しくありません" & vbCrLf & vbCrLf & _
"パス：" & strPath, vbExclamation + vbOKOnly, "パスエラー")
GoTo test_End
End If

' シート名保存
Set objDic = CreateObject("Scripting.Dictionary")
objDic.Add "1", Worksheets("1").Index ' ★2
objDic.Add "2", Worksheets("2").Index ' ★2
objDic.Add "3", Worksheets("3").Index ' ★2
objDic.Add "4", Worksheets("4").Index ' ★2
objDic.Add "5", Worksheets("5").Index ' ★2
objDic.Add "6", Worksheets("6").Index ' ★2
objDic.Add "7", Worksheets("7").Index ' ★2
objDic.Add "8", Worksheets("8").Index ' ★2
objDic.Add "9", Worksheets("9").Index ' ★2
objDic.Add "10", Worksheets("10").Index ' ★2

For Each objLp In objFSO.GetFolder(strPath).Files
If objDic.Exists(objFSO.GetBaseName(objLp.Name)) Then
Set wsPaste = Worksheets(objDic.Item(objFSO.GetBaseName(objLp.Name)))
Workbooks.Open Filename:=objLp.Path
Set wsCopy = ActiveWorkbook.ActiveSheet

wsCopy.Cells.Copy ' ★3
wsPaste.Cells.PasteSpecial Paste:=xlValues ' ★3

Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=False
Application.DisplayAlerts = True
End If
Next

test_End:
Set objFSO = Nothing
Set objLp = Nothing
Set objDic = Nothing
Application.ScreenUpdating = True
End Sub

補足

初歩的な質問で申し訳ありません。

修正部分★１の
「フォルダのパスを指定するセルに変える。サンプルだと集計シートのセルB2」ですが

フォルダのパスとは何ですか？