【エクセルマクロ】月別に別シート転記：動画あり

エクセルマクロで、月別にデータ抽出して別シート転記する方法をご紹介します。

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

月別に別シート転記（パターン1）

以下のマクロを実行すると、特定の月のデータを抽出します。

Sub 特定月のデータを別シート抽出()

Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim LastRow As Long
Dim i As Long
Dim Q As Long
Dim Buf As Variant

    Set sht1 = Sheets("Sheet1")
    Set sht2 = Sheets("Sheet2")

    'sht2のデータをクリア
    sht2.Select
    sht2.Range(Range("A2"), Range("A2").SpecialCells(xlLastCell)).ClearContents
    
    '最終行を取得
    LastRow = sht1.Cells(Rows.Count, 1).End(xlUp).Row
    
    '転記開始行
    Q = 2
    
    '抽出月を取得
    Buf = Format(sht1.Range("F1"), "yyyymm")
    
    Application.ScreenUpdating = False
    
    sht1.Select
    
    '2～最終行までループ
    For i = 2 To LastRow
    
        'C列が抽出月と同じだったら
        If Format(sht1.Cells(i, 3), "yyyymm") = Buf Then
        
            '別シートにA～C列を転記
            sht1.Range(Cells(i, 1), Cells(i, 3)).Copy sht2.Cells(Q, 1)
            Q = Q + 1
        End If
    
    Next i
    
    Application.ScreenUpdating = True
    
End Sub

マクロ実行前

抽出したい年月を、セルF1に入力しておきます。

マクロ実行後

該当月のデータを、別シートに転記します。

セルF1の年月を変更してマクロを実行すると、

別シートのデータが自動で入れ替わります。

月別に別シート転記（パターン2）

以下の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 = Format(Cells(i, 3), "yyyymm")

        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 Format(Matome_Sht.Cells(j, 3), "yyyymm") = 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

マクロ実行前

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

マクロ実行後

「まとめ」シートのC列の年月ごとに、

新規シートを自動作成して、データを転記します。

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

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

...

kirinote.com

2023.02.04