【VBA】雛型を使って月ごとに別シート転記【DictionaryとCopyを使う】

Sub TEST1()
  
  'シートをクリア
  Sheets("ベース").Range("B3,A6:F9") = ""
  
  Dim A, B
  A = DateSerial(2022, 1, 1) '1日の日付
  B = DateSerial(2022, 1 + 1, 0) '月末の日付
  
  '年月を入力
  Sheets("ベース").Range("B3") = Format(A, "yyyy年m月")
  
  j = 5
  '商品をループ
  For i = 2 To Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Row
    '指定月のデータを取得
    If A <= Sheets("DB").Cells(i, "A") And Sheets("DB").Cells(i, "A") <= B Then
      j = j + 1
      Sheets("ベース").Cells(j, "A") = Sheets("DB").Cells(i, "A") '取引日
      Sheets("ベース").Cells(j, "C") = Sheets("DB").Cells(i, "B") '商品
      Sheets("ベース").Cells(j, "E") = Sheets("DB").Cells(i, "C") '売上
    End If
  Next
  
  'シートを追加
  Sheets("ベース").Copy after:=Sheets(Sheets.Count)
  ActiveSheet.Name = Format(A, "yyyy年m月") 'シート名を変更
  
End Sub

Sub TEST2()
  
  'リストをループ
  For m = 1 To 3
    
    'シートをクリア
    Sheets("ベース").Range("B3,A6:F9") = ""
    
    Dim A, B
    A = DateSerial(2022, m, 1) '1日の日付
    B = DateSerial(2022, m + 1, 0) '月末の日付
    
    '年月を入力
    Sheets("ベース").Range("B3") = Format(A, "yyyy年m月")
    
    j = 5
    '商品をループ
    For i = 2 To Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Row
      '指定月のデータを取得
      If A <= Sheets("DB").Cells(i, "A") And Sheets("DB").Cells(i, "A") <= B Then
        j = j + 1
        Sheets("ベース").Cells(j, "A") = Sheets("DB").Cells(i, "A") '取引日
        Sheets("ベース").Cells(j, "C") = Sheets("DB").Cells(i, "B") '商品
        Sheets("ベース").Cells(j, "E") = Sheets("DB").Cells(i, "C") '売上
      End If
    Next
    
    'シートを追加
    Sheets("ベース").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Format(A, "yyyy年m月") 'シート名を変更
    
  Next
  
End Sub

Sub TEST3()
  
  Dim C
  '辞書を作成
  Set C = CreateObject("Scripting.Dictionary")
  
  '年月のリストを作成
  For i = 2 To Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Row
    If C.exists(Format(Sheets("DB").Cells(i, "A"), "yyyy年m月")) = False Then
      C.Add Format(Sheets("DB").Cells(i, "A"), "yyyy年m月"), ""
    End If
  Next
  
  Dim D
  '年月のリストを配列に格納
  D = C.keys
  
  'リストをループ
  For m = 0 To UBound(D)
    
    'シートをクリア
    Sheets("ベース").Range("B3,A6:F9") = ""
    
    Dim A, B
    A = DateSerial(Year(D(m)), Month(D(m)), 1) '1日の日付
    B = DateSerial(Year(D(m)), Month(D(m)) + 1, 0) '月末の日付
    
    '年月を入力
    Sheets("ベース").Range("B3") = D(m)
    
    j = 5
    '商品をループ
    For i = 2 To Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Row
      '指定月のデータを取得
      If A <= Sheets("DB").Cells(i, "A") And Sheets("DB").Cells(i, "A") <= B Then
        j = j + 1
        Sheets("ベース").Cells(j, "A") = Sheets("DB").Cells(i, "A") '取引日
        Sheets("ベース").Cells(j, "C") = Sheets("DB").Cells(i, "B") '商品
        Sheets("ベース").Cells(j, "E") = Sheets("DB").Cells(i, "C") '売上
      End If
    Next
    
    'シートを追加
    Sheets("ベース").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = D(m) 'シート名を変更
    
  Next
  
End Sub