MENU

【ツール】リスト形式のデータを、コピーした定型シートに、内容別に転記

たとえば、下の図のように「納品データを取引先別に請求書フォーマットに貼り付ける」ことができます。

f:id:The-Alchemist:20220217154203p:plain

アプリの入力画面

f:id:The-Alchemist:20220217162218p:plain

アプリの出力画面

「コードをコピーする」ボタンから、コードをエクセルのVBE画面に貼り付けて、実行します。

f:id:The-Alchemist:20220217163023p:plain

作成されるコード

  
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ページ ⇒ シート ⇒ 【ツール】シートの存在チェック

f:id:The-Alchemist:20220217203854p:plain

 

 

アプリはこちらから↓↓↓↓