.png)
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
各シートの繰り返し編:ポイント
- 配列変数arrはVariant型で宣言します。
- 配列変数arrをReDimで要素1つ分をString型で指定します。
- ForEach文はシートのコレクションでループします。
- If文はシート名をワイルドカードで対応させたかったのでLike演算子を使います。
- 配列の要素が空欄でなければ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

コメントを投稿
別ページに移動します