【エクセルマクロ】条件に合うデータを別シート転記 2選

エクセルマクロで、条件に合うデータを別シートへ転記するVBAコードをご紹介します。

こちらサイト経由でご質問をいただきました内容について、方法をご紹介します。

条件に合うデータを別シート転記（パターン1）

以下のExcelVBAを実行すると、複数条件が一致するデータを別シートへ抽出します。

Sub 条件があうものを抽出()

Dim List_Sht As Worksheet
Dim Target_Sht As Worksheet
Dim LastRow As Long
Dim A_LastRow As Long
Dim B_LastRow As Long
Dim LastClm As Long
Dim i As Long
Dim Buf As String

    Set List_Sht = Sheets("リスト")
    List_Sht.Select
    A_LastRow = 2
    B_LastRow = 31

    '最終行
    LastRow = List_Sht.Cells(Rows.Count, 1).End(xlUp).Row

    '最終列
    LastClm = List_Sht.Cells(1, Columns.Count).End(xlToLeft).Column

    '「リスト」シート ループ
    For i = 2 To LastRow

        'L列とM列を結合して変数へ格納
        Buf = Cells(i, 12) & Cells(i, 13)

        '判定
        If Buf = "1001" Then
            Set Target_Sht = Sheets("○")
            
            If Target_Sht.Cells(2, 1) <> "" Then
                A_LastRow = Target_Sht.Cells(1, 1).End(xlDown).Row + 1
            End If

        ElseIf Buf = "1003" Then
            Set Target_Sht = Sheets("☆")
            A_LastRow = Target_Sht.Cells(Rows.Count, 1).End(xlUp).Row + 1

        ElseIf Buf = "2001" Then
            Set Target_Sht = Sheets("○")
            A_LastRow = B_LastRow
            B_LastRow = B_LastRow + 1

        End If

        'データコピペ
        List_Sht.Range(Cells(i, 1), Cells(i, LastClm)).Copy Target_Sht.Cells(A_LastRow, 1)
    Next

End Sub

参照元シート

「リスト」シートの L列 と M列 を参照して、

条件にあうデータを指定シートへ転記します。

条件によって、転記シートと転記開始行が指定されています。

別シート転記後

指定条件ごとに別シートへ転記します。

条件に合うデータを別シート転記（パターン2）

以下のExcelVBAを実行すると、複数条件が一致するデータを別シートへ抽出します。

Sub 条件があうものを抽出()

Dim List_Sht As Worksheet
Dim Target_Sht As Worksheet
Dim Chk As Boolean
Dim LastRow As Long
Dim S_LastRow As Long
Dim LastClm As Long
Dim i As Long
Dim Buf As String

    Set List_Sht = Sheets("リスト")
    List_Sht.Select
    Chk = False

    '最終行
    LastRow = List_Sht.Cells(Rows.Count, 1).End(xlUp).Row

    '最終列
    LastClm = List_Sht.Cells(1, Columns.Count).End(xlToLeft).Column

    '「リスト」シート ループ
    For i = 2 To LastRow

        'L列とM列を結合して変数へ格納
        Buf = Cells(i, 12) & Cells(i, 13)

        '判定
        If Buf = "1001" Then
            Set Target_Sht = Sheets("○")

        ElseIf Buf = "1003" Then
            Set Target_Sht = Sheets("☆")

        ElseIf Buf = "2001" Then
            Set Target_Sht = Sheets("◎")

            If Chk = False Then
                 S_LastRow = 31
                 Chk = True
            Else
                S_LastRow = Target_Sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
        End If

        'シートの最終行を取得
        If Buf <> "2001" Then
            S_LastRow = Target_Sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If

        'データコピペ
        List_Sht.Range(Cells(i, 1), Cells(i, LastClm)).Copy Target_Sht.Cells(S_LastRow, 1)
    Next

End Sub

参照元シート

「リスト」シートの L列 と M列 を参照して、

条件にあうデータを指定シートへ転記します。

条件によって、転記シートと転記開始行が異なります。

別シート転記後

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

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

...

kirinote.com

2023.02.04