エクセルマクロについて教えてください。 1つのシートにあるデータを支社名毎にブック分割(シートは1つ)しています。(マクロにて※後述) 元々のデータが5つあるので、1つの支社名で5つのブックが作成されています。 支社名数×5つブックは同じフォルダーにあります。 これらのブックを支社名毎に5つのブックを1つのブック(5つのシート)にまとめたいのですが どのようなマクロを組めばよいでしょうか? ブック名称及びシート名称は元々のデータごとに 「支社名_○データ」「支社名_×データ」「支社名_△データ」 となっています。 支社名一覧を準備することはできますが、支社名によってデータがでない月もあります。 1つのブックにまとめた後、元々のブックが削除されると助かります。 以下、参考となりますが、踏まえて回答いただけるとうれしいです。 ※データを分割するマクロは以下です。 (過去に知恵袋等ネットで拾ったものを活用しています。) このマクロを2つのブック(計5つのシート)に対して リスト項目やタイトル行がシート毎に異なるので支社名の位置に合わせて、シート毎のマクロを実行しています。 Sub 支社名毎に分割() Dim xPath As String Dim xDate As String Dim sh0 As Worksheet Dim sh1 As Worksheet Dim xRng As Range Dim 最終行 As Long Dim 最終列 As Long With Application.FileDialog(msoFileDialogFolderPicker) .Title = "保存先フォルダの選択" .AllowMultiSelect = False If .Show = -1 Then xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\" Else Exit Sub End If End With xDate = Format(Date, "_yyyymmdd") Application.ScreenUpdating = False Set sh0 = ActiveSheet 最終行 = sh0.Cells(Rows.Count, 1).End(xlUp).Row 最終列 = sh0.Cells(2, Columns.Count).End(xlToLeft).Column sh0.Copy After:=sh0 Set sh1 = ActiveSheet With Worksheets.Add 'sh0.Columns(1).Copy sh0.Activate sh0.Range(Cells(2, 1), Cells(最終行, 1)).Copy .Activate .Columns(1).PasteSpecial xlPasteValues .Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes .Cells(1).Copy .Cells(1, 2) For Each xRng In .Range("A2", .Cells(Rows.Count, 1).End(xlUp)) sh1.Rows("2:" & 最終行).ClearContents xRng.Copy .Cells(2, 2) sh0.Activate sh0.Range(Cells(2, 1), Cells(最終行, 最終列)).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=.Cells(1, 2).Resize(2), CopyToRange:=sh1.Cells(2, 1), Unique:=False With sh1 .Name = xRng.Value & "_○データ" .Copy End With With ActiveWorkbook .SaveAs xPath & xRng.Value & "_○データ" & ".xlsx" .Close End With 文字数オーバーなので補足へ続きます。
Excel