複数ブックからシートをコピー

Question

前提・実現したいこと

複数ブックからシートをコピーしたいです。

3つのブックからシートを元ブックにコピーしてくる場合
For文を使うのはわかるのですが、どう書けばいいのかわからないので
教えていただきたいです。

今はブック名のところを編集して同じコードを3つ書いています。

該当のソースコード

Sub test1()


    ' ブック("Book1.xlsx)のシート(“Sheet1”)をアクティブ
    Workbooks("Book1.xlsx").Worksheets("Sheet1").Activate
    ' アクティブなシートをコピーして、ブック("Test.xlsm")の１番目のシートの後に挿入
    ActiveSheet.Copy after:=Workbooks("Test.xlsm").Sheets(1)

    WIth ActiveSheet.UsedRange
        .Value = .Value
    End With 

End Sub

Sub test2()


    ' ブック("Boo2.xlsx)のシート(“Sheet1”)をアクティブ
    Workbooks("Book2.xlsx").Worksheets("Sheet1").Activate
    ' アクティブなシートをコピーして、ブック("Test.xlsm")の１番目のシートの後に挿入
    ActiveSheet.Copy after:=Workbooks("Test.xlsm").Sheets(1)

    WIth ActiveSheet.UsedRange
        .Value = .Value
    End With 

End Sub

Sub test3()


    ' ブック("Book3.xlsx)のシート(“Sheet1”)をアクティブ
    Workbooks("Book3.xlsx").Worksheets("Sheet1").Activate
    ' アクティブなシートをコピーして、ブック("Test.xlsm")の１番目のシートの後に挿入
    ActiveSheet.Copy after:=Workbooks("Test.xlsm").Sheets(1)

    WIth ActiveSheet.UsedRange
        .Value = .Value
    End With 

End Sub

Answer 1

実際には"一覧表"という文字が含めばという風にしたいです。

開いているブックでブック名に "一覧表" がふくまれているブックを対象にするということでしょうか。

    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name Like "*一覧表*" Then
            wb.Worksheets("Sheet1").Activate

            '以下略

        End If
    Next wb

Comments

[pomiw0000]

その通りです。ありがとうございます。
あと一つ、質問なのですが
この処理をしている前にファイルを開く　という以下のコードを記述しています。

Sub ファイル開く()

Dim FolderPath, FileName
FolderPath = ThisWorkbook.Path & "\ファイル" 'フォルダパスを作成
FileName = Dir(FolderPath & "*") '最初のファイル名を取得

Do While FileName <> ""
'ファイルを開く
Workbooks.Open FileName:=FolderPath & "\" & FileName
FileName = Dir() '次のファイル名を取得
Loop

End Sub

別々にコードを書かずに回答していただいたコードの中に
対象のファイルを開く　というコードも一緒に入れたいです。

対象のファイルを開いて他ブックにコピーして閉じる
↓
次のファイルを開いて他ブックにコピーをして閉じる

という繰り返し作業をしたいです。

コード化にすることは可能でしょうか。
また、質問をしてしまい大変申し訳ございません。

[hatena19]

ブックは開いてなくて、特定のフォルダー内のファイル名に"一覧表"を含むブックを開いて、
そのブックのSheet1をコピーするということですね。
説明を省略せずに最初からそのように書いた方かよかったですね。

Sub ファイル開く()

Dim FolderPath As String, FileName As String
FolderPath = ThisWorkbook.Path & "\ファイル" 'フォルダパスを作成
FileName = Dir(FolderPath & "*") '最初のファイル名を取得

Do While FileName <> ""

If FileName Like "*一覧表*" Then
'ファイルを開く
Dim wb As Workbook
Set wb = Workbooks.Open(FileName:=FolderPath & "\" & FileName)
wb.Worksheets("Sheet1").Activate

'以下略

wb.Close
End If
FileName = Dir() '次のファイル名を取得
Loop

End Sub

[pomiw0000]

すみません、ありがとうございます!
思い通りに動きました。
わざわざ、二度も答えていただきありがとうございます。

Answer 2

Book1,2,3…と番号のところだけ変わるのであれば、

FOR I=1 TO N
 Filename="Book" + Format(I,"###") + ".xlsx"
 Workbooks(Filename).Worksheets("Sheet1").Activate
 ' 以下略

が簡単でしょうか

Comments

[pomiw0000]

回答ありがとうございます。
Book1.Book2は例で書いてあるだけでありまして、
実際には"一覧表"という文字が含めばという風にしたいです。