VBA 項目別にシートを分ける(別シート転記）動画あり

エクセルマクロで、項目別にシートを分けるVBAコードをご紹介します。

このページのマクロコードは、コピペで使えます。
ぜひお試しください！

項目別にシートを分ける

以下のExcelVBAを実行すると、項目毎に別々のシートに自動転記します。

Sub 得意先ごとに別シート抽出()
    
Dim Tokuisaki_List As Worksheet
Dim Data As Worksheet
Dim Genshi As Worksheet
Dim i As Long
Dim J As Long
Dim RowCnt  As Long
Dim LastRow  As Long
Dim List_Cnt As Long
Dim ShtName As String
    
    '各シートを変数代入
    Set Tokuisaki_List = Sheets("得意先一覧")
    Set Data = Sheets("データ")
    Set Genshi = Sheets("原紙")

    '「得意先一覧」 最終行
    List_Cnt = Tokuisaki_List.Cells(Rows.Count, 1).End(xlUp).Row

    '「データ」 最終行
    LastRow = Data.Cells(Rows.Count, 1).End(xlUp).Row
    
    Application.ScreenUpdating = False

        '「得意先一覧」をもとに新規シート作成
        For i = 2 To List_Cnt
            Genshi.Copy Before:=Worksheets(1)
            ActiveSheet.Name = Tokuisaki_List.Cells(i, 1)
        Next i

        '得意先の数をループ
        For i = 2 To List_Cnt
        
            Data.Select
            
            '貼り付け開始行
            RowCnt = 2
            
            'シート名取得
            ShtName = Tokuisaki_List.Cells(i, 1)
        
            '「データ」 2～最終行までループ
            For J = 2 To LastRow
            
                '「データ」 に 「得意先一覧」 と同じ名称があったら
                If Tokuisaki_List.Cells(i, 1) = Data.Cells(J, 2) Then

                    '「データ」  A～D列の値を、該当シートに貼り付け
                    Data.Range(Cells(J, 1), Cells(J, 4)).Copy Sheets(ShtName).Cells(RowCnt, 1)
                    
                    '貼り付け開始行を更新
                    RowCnt = RowCnt + 1
            
                End If
            Next J
        Next i

    Application.ScreenUpdating = True

End Sub

マクロ実行前

「得意先一覧」シートに、会社名を入力しておきます。

「原紙」シートは、項目ごとのシートを作る際に使用します。

「データ」シートに、振り分けたいデータを入力しておきます。

マクロ実行後

得意先ごとにシートを作成して、データを転記します。

 
 
この記事がお役に立ちますと幸いです。
 
・【エクセルマクロ】別シート転記を自動処理する方法まとめ
 

【エクセルマクロ】別シート転記(抽出)を自動化する：超便利20選

...

kirinote.com

2023.02.04