【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で要素１つ分をString型で指定します。
3. ForEach文はシートのコレクションでループします。
4. If文はシート名をワイルドカードで対応させたかったのでLike演算子を使います。
5. 配列の要素が空欄でなければReDim Preserveで配列を増やします。

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

今度は各シートの名前を１件ずつ確認するのではなく、移動させたいシート名のリストがあるとします。各シートの繰り返しとほぼ同様ですが、セル範囲をループさせるため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）にこだわってしまいましたが、どのやり方が一番良いのかは好みなところもありますので、どれが正解っていう一つだけの答えを示すのも良くないのかもしれませんね。

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

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

Sub Sample_003()

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

End Sub