【エクセルマクロ】データを抽出して別シートへ転記:コピペで使えるコード

ExcelVBA_データ抽出し別シート転記-アイキャッチ エクセルマクロで効率化する

エクセルマクロで、データを抽出して別シートへ転記するVBAコードをご紹介します。

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

データを抽出して別シートへ転記

以下のExcelVBAを実行すると、別シートにデータを振り分けします。


Sub 条件に合うデータを別シートへ抽出()

Dim Matome_Sht As Worksheet
Dim DicName As Variant
Dim GetName As String
Dim myKey As Variant
Dim LastRow As Long
Dim i As Long
Dim j As Long
Dim Q As Long

    '連想配列
    Set DicName = CreateObject("Scripting.Dictionary")

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

    Set Matome_Sht = Sheets("まとめ")

    '重複しないリストを連想配列へ
    For i = 2 To LastRow
        GetName = Cells(i, 1)

        If Not DicName.Exists(GetName) Then
            DicName.Add GetName, GetName
        End If
    Next i

    '連想配列をループ
    myKey = DicName.keys
    For i = 0 To UBound(DicName.items)
    
        Q = 2

        '新規シート作成し、1行目のみ転記
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Name = myKey(i)
        ActiveSheet.Range("A1:C1").Value = Matome_Sht.Range("A1:C1").Value

        Matome_Sht.Select

        '「まとめ」シート セルA2から最終行までループ
        For j = 2 To LastRow

            '連想配列とセル値が一致している場合
            If Matome_Sht.Cells(j, 1) = myKey(i) Then
            
                 '「まとめ」シートの値を転記
                 Matome_Sht.Range(Cells(j, 1), Cells(j, 3)).Copy Sheets(myKey(i)).Cells(Q, 1)
                 Q = Q + 1

            End If
        Next j
    Next i

    Set DicName = Nothing

End Sub

 

マクロ実行前

「まとめ」シートにデータが入力されている状態です。


 

マクロ実行後

商品名ごとに新規シートを自動作成して、データを転記します。


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

【エクセルマクロ】色のついたセルを別シートに抽出:3倍高速化する!
...