編集

【ExcelVBA】複数のシートを新規ブックに移動させる

2025/07/26
【ExcelVBA】複数のシートを新規ブックに移動させる

ExcelVBAで複数のシートをまとめて新規ブックに移動させる方法の備忘録です。作成したシート群を別のブックに吐き出す処理はあまり実用性はないかもしれませんが、動的配列やワイルドカード指定、繰り返し処理の勉強になるかと思い、記録しておきます。

各シートの繰り返し編:やりたいこと

イメージとしては、頭に「集計_(アンダーバー)」がついているシート名を別のExcelファイルとして保存したい場合です。手作業であれば、対象のシートを選択して右クリックすると「移動またはコピー」という動作が今回の対象です。

やりたいこと

各シートの繰り返し編:ソースコード(ExcelVBA)

Sub Sample_001()

 Dim arr As Variant
 Dim j As Long
 Dim WS As Worksheet

 ReDim arr(0) As String

 For Each WS In Sheets
   If WS.Name Like "集計_*" Then
   If arr(j) <> "" Then
     j = j + 1
     ReDim Preserve arr(j)
    End If
    arr(j) = WS.Name
   End If 
 Next

 Sheets(arr).Move
 ActiveWorkbook.SaveAs "C:\Users\Tomoyuki\Desktop\test.xlsx"
 ActiveWorkbook.Close

End Sub

各シートの繰り返し編:ポイント

  1. 配列変数arrはVariant型で宣言します。
  2. 配列変数arrをReDimで要素1つ分をString型で指定します。
  3. ForEach文はシートのコレクションでループします。
  4. If文はシート名をワイルドカードで対応させたかったのでLike演算子を使います。
  5. 配列の要素が空欄でなければReDim Preserveで配列を増やします。

セル範囲の繰り返し編:やりたいこと

今度は各シートの名前を1件ずつ確認するのではなく、移動させたいシート名のリストがあるとします。各シートの繰り返しとほぼ同様ですが、セル範囲をループさせるためRangeオブジェクトを使用しています。

抽出したいシート

↓↓↓

出力結果

セル範囲の繰り返し編:ソースコード(ExcelVBA)

Sub Sample_002()
 
    Dim arr As Variant
    Dim j As Long
    Dim Rng As Range
 
    ReDim arr(0) As String
 
    For Each Rng In Range("A1:A7")
        If arr(j) <> "" Then
            j = j + 1
            ReDim Preserve arr(j)
        End If
        arr(j) = Rng
    Next
    
    Sheets(arr).Move
    ActiveWorkbook.SaveAs "C:\Users\Tomoyuki\Desktop\test.xlsx"
    ActiveWorkbook.Close
 
End Sub

セル範囲の繰り返し編:ポイント

一括でシートの移動をさせたいので、一次元配列(arr)にこだわってしまいましたが、どのやり方が一番良いのかは好みなところもありますので、どれが正解っていう一つだけの答えを示すのも良くないのかもしれませんね。

セル範囲をそのまま一括で配列に格納して...というのも考えたのですが、結局セル範囲を配列にすると2次元配列になってしまうので、それをループするのも...などなど考えてしまいました。

補足としてセル範囲を配列に格納するコードも記載しておきます。

Sub Sample_003()

    Dim arr As Variant
    arr = Range("A1:A7")

End Sub
Excelのセル範囲を2次元配列に格納する