たとえば、下の図のように「納品データを取引先別に請求書フォーマットに貼り付ける」ことができます。
アプリの入力画面
アプリの出力画面
「コードをコピーする」ボタンから、コードをエクセルのVBE画面に貼り付けて、実行します。
作成されるコード
Sub デモ_1() '項目ごとに定型シート作成
Dim セル範囲 As String, セル As Range, 右下セル As String
Sheets("納品データ").Select
'◆最終行を取得し、セル範囲を決める
Range("a1:f1").CurrentRegion.Select
右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("f1").Column).Address(False, False)
セル範囲 = "a1" & ":" & 右下セルRange(セル範囲).Select
Call デモ_1_メイン処理(セル範囲)
End Sub
Sub デモ_1_メイン処理(セル範囲 As String)
Dim 元シート As Worksheet
Set 元シート = ActiveSheet
'◆切り分ける項目リストを作成
Worksheets.Add.Name = "フィルタOP"
Dim フィルタ範囲 As Range, フィルタ列 As Long
Set フィルタ範囲 = Worksheets("フィルタOP").Range("A1")
元シート.Range(セル範囲).Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=フィルタ範囲, Unique:=True
Set フィルタ範囲 = フィルタ範囲.CurrentRegion
'◆項目別シートを作成
Worksheets.Add.Name = "フィルタOP2"
Dim 項目 As Long, 項目名 As String
For 項目 = 2 To フィルタ範囲.Rows.Count
項目名 = フィルタ範囲.Cells(項目, 1).Value
Worksheets("原本").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = 項目名
フィルタ範囲.Cells(2, 1).Value = 項目名
元シート.Range(セル範囲).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=フィルタ範囲.Rows("1:2"), CopyToRange:=Sheets("フィルタOP2").Range("A1")
Worksheets("フィルタOP2").Range("A1").CurrentRegion.Copy Sheets(項目名).Range("b7")
Worksheets("フィルタOP2").Range("A1").CurrentRegion.Clear
Worksheets(項目名).Range("b7").CurrentRegion.EntireColumn.AutoFit
Next 項目
Worksheets("フィルタOP").Delete
Worksheets("フィルタOP2").Delete
End Sub
オプション
連続トリガーを使い、前処理で「データを貼り付ける定型シート」の存在をチェックできます。
TOPページ ⇒ シート ⇒ 【ツール】シートの存在チェック
