【エクセルマクロ】項目別にシートを分ける(別シート転記):動画あり

vba-項目別にシートを分ける-アイキャッチ ExcelVBA

エクセルマクロで、項目別にシートを分ける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

 

マクロ実行前

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


 

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


 

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


 

マクロ実行後

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


 

動画解説

クリックして再生できます^^

 
この記事がお役に立てれば幸いです。
 

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

 

「プログラマーの本気がExcelを覚醒させる 超絶ExcelVBA」
ExcelVBAでワンランクアップできる書籍
具体的で応用が利く技をたくさん掲載