Boa noite!!

Veja se te ajuda

Sub CopiarAleVBA_8819()
Dim i As Long, c As Long, lr As Long
Dim MyCriterio As String
Dim WS As Worksheet

Set WS = Worksheets("lista de compra")

    With Worksheets("lista de compra")
    .Range("A4:D12").Sort Key1:=[A3], Order1:=xlAscending, Header:=xlYes
    End With
    
    MyCriterio = WS.[C1].Value
    lr = Worksheets(MyCriterio).Cells(Rows.Count, 1).End(xlUp).Row + 1
    WS.Range("A4:D12").Copy Worksheets(MyCriterio).Range("A" & lr)
End Sub

Ola Alexandrevba, e obrigado pela ajuda!

Quando executei a macro ela copia os itens que não tem quantidade. Tem como ela não copiar esses Produtos?

Mais uma vez Obrigado!!!

Boa noite!!

Veja se é isso

Alexandre Muito obrigado!!!

Boa noite!!

Lembre se que os nomes das guias, devem ser idênticos ao da célula C1 e da rotina!!

Att

Alexandre para pode alterar a macro que apaga automaticamente de mês para números como faço?

Sub DeletarLinha()
    Dim Sh, vSheets
     
    vSheets = Array("Janeiro", "Fevereiro", "Março", "Abril", "Maio", "Junho", "Julho", "Agosto", "Setembro", "Outubro", "Novembro", "Dezembro")
    For Each Sh In vSheets
        With Sheets(Sh)
            On Error Resume Next    'keep going if no blank rows found in range
            .Range("A4:A20").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        End With
    Next Sh
    
End Sub

Só para completar, é que por numero tenho opção de usar a lista varias vezes no mesmo mês! e poço usa essa lista para outras coisas também!