Excel VBA | 複数ブックにまたがって条件付きで特定のシートをコピーする

Excel VBA VBA
2011.03.08
スポンサーリンク

ここでは 複数ブックにまたがって条件付きで特定のシートをコピーする VBAの例を紹介します。ポイントは「開いている複数のブックをループし、条件に合致するシートを ws.Copy で別ブックにコピーする」ことです。

⚠️ 注意：コピー先のブックを明示的に指定する必要があります。ここでは例として「Master.xlsx」という統合用ブックにコピーします。

基本例：シート名が「Report」で始まるシートをコピー

Sub 複数ブックで特定シートコピー()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim destWb As Workbook
    
    ' コピー先ブックを指定（事前に開いておく）
    Set destWb = Workbooks("Master.xlsx")
    
    For Each wb In Application.Workbooks
        If wb.Name <> ThisWorkbook.Name And wb.Name <> destWb.Name Then
            For Each ws In wb.Worksheets
                If Left(ws.Name, 6) = "Report" Then
                    ws.Copy After:=destWb.Sheets(destWb.Sheets.Count)
                End If
            Next ws
        End If
    Next wb
End Sub
VB

👉 開いているすべてのブックで、シート名が「Report」で始まるシートを「Master.xlsx」にコピーします。

応用例1：セルの値で判定してコピー

Sub セルの値でシートコピー()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim destWb As Workbook
    
    Set destWb = Workbooks("Master.xlsx")
    
    For Each wb In Application.Workbooks
        If wb.Name <> ThisWorkbook.Name And wb.Name <> destWb.Name Then
            For Each ws In wb.Worksheets
                ' A1セルが「コピー」と書かれていたらコピー
                If ws.Range("A1").Value = "コピー" Then
                    ws.Copy After:=destWb.Sheets(destWb.Sheets.Count)
                End If
            Next ws
        End If
    Next wb
End Sub
VB

👉 各シートのA1セルに「コピー」と書いてある場合のみ、そのシートを「Master.xlsx」にコピーします。

応用例2：複数条件を組み合わせてコピー

Sub 複数条件でシートコピー()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim destWb As Workbook
    
    Set destWb = Workbooks("Master.xlsx")
    
    For Each wb In Application.Workbooks
        If wb.Name <> ThisWorkbook.Name And wb.Name <> destWb.Name Then
            For Each ws In wb.Worksheets
                ' 条件1: シート名が「Data」で始まる
                ' 条件2: B2セルの値が100以上
                If Left(ws.Name, 4) = "Data" And ws.Range("B2").Value >= 100 Then
                    ws.Copy After:=destWb.Sheets(destWb.Sheets.Count)
                End If
            Next ws
        End If
    Next wb
End Sub
VB

👉 シート名が「Data」で始まり、かつB2セルの値が100以上なら、そのシートを「Master.xlsx」にコピーします。

ポイント

  • シートコピー → ws.Copy After:=destWb.Sheets(destWb.Sheets.Count)
  • コピー先ブックを指定 → Set destWb = Workbooks("Master.xlsx")
  • 複数ブックをループ → For Each wb In Application.Workbooks
  • 条件判定 → シート名やセルの値を使って柔軟に設定

練習課題

  1. 全ブックの「Sheet2」を「Master.xlsx」にコピーするコードを書いてみる
  2. 各シートのC1セルが「Copy」と書かれていたらコピーするコードを作る
  3. 複数条件を組み合わせて「シート名がReportで始まり、A1セルが空でないならコピー」にするコードを作る

こうした仕組みを作ると、複数ブックにまたがって条件付きで特定のシートをコピーする自動化ツールが完成します。

スポンサーリンク
タイトルとURLをコピーしました