Access Duplicar infomações na tabela

[Flaa]

Bom dia!
Por exemplo, tenho uma tabela com 3 colunas, Período, Produto e Valor.

Preciso de algo automático para repetir as mesmas informações de Produto e Valor, mudando apenas o Período.
Por exemplo, a tabela original tem as linhas abaixo, queria criar uma tabela com essas 4 linhas, mudando o Período para 2019/11, 2019/10... até 2016/01.

Pensei em criar várias consultas, criando um campo novo com o novo período, mas como vou precisar a partir de 2016, são muitas consultas e corre o risco de erro quando for atualizar mensalmente.

Tabela Produtos
Periodo    Produto    Valor
2019/12   Caderno   15
2019/12   Lapis         2
2019/12   Borracha   3
2019/12   Caneta      6

[Basole]

Minha sugestao e voce duplicar esses dados por exemplo no Excel

Em seguiida transferir para sua tabela do Aceess

Exemplo:

Const dbPath = "C:\Users\user\Desktop\teste.accdb" ' ***ALTERE O LOCAL DO SEU ACCESS ****

Sub DuplicarDados()
Dim arr(1 To 4, 1 To 2) As Variant
Dim arrM(1 To 12) As Variant
Dim arrY(1 To 4) As Variant

arr(1, 1) = ("Caderno"): arr(1, 2) = (15)
arr(2, 1) = ("Lapis"): arr(2, 2) = (2)
arr(3, 1) = ("Borracha"): arr(3, 2) = (3)
arr(4, 1) = ("Caneta"): arr(4, 2) = (6)

For i = 1 To 12
     arrM(i) = i
Next i

For i = 1 To 4
   arrY(i) = 2015 + i
Next i

j = 1
i = 4

 Cells.Clear
 Cells(j, "A") = "Periodo"
 Cells(1, "B") = "Produto"
 Cells(1, "C") = "Valor"
                
For y = UBound(arrY) To 1 Step -1
    For r = UBound(arrM) To 1 Step -1
        For i = 1 To UBound(arr)
           ul = Cells(Rows.CountLarge, 1).End(xlUp).Offset(1).Row
             If arrY(y) & "/" & arrM(r) <> "2019/12" Then
                Cells(ul, "A") = arrY(y) & "/" & VBA.Format(arrM(r), "00")
                Cells(ul, "B") = arr(i, 1)
                Cells(ul, "C") = arr(i, 2)
             End If
        Next i
    Next r
Next y
    Call TransferirParaAccess
End Sub

Sub TransferirParaAccess()

  Set cn = CreateObject("ADODB.Connection")
  scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
  cn.Open scn
  Set rs = CreateObject("ADODB.Recordset")
   rs.Open "Produtos", cn, 1, 3
    r = 2
    
Do While VBA.Len(Range("A" & r).Value) > 0
    If Not rs.EOF Then
    With rs
        .AddNew
            .Fields("Periodo") = Cells(r, "A").Value
            .Fields("Produto") = Cells(r, "B").Value
            .Fields("Valor") = Cells(r, "C").Value
        .Update
    End With
    r = r + 1
    End If
Loop

rs.Close

End Sub