Excel VBA EXCEL- comando de celulas duplicadas não funciona

[isabela queiroz]

tenho esse codigo aqui que funciona perfeitamente, fora a parte de copiar e colar sem fazer celulas duplicadas, não se se ta dando errado por eu estar mandando pegar do autofilter ou se ta dando errado por outro motivo:

 

Sub Atualiza()

'-------------------------AQUI SERIA A PARTE DO CODIGO QUE TA DANDO ERRADO-----------------------------------

    Sheets("Preenchendo_dados").Select
    Columns("C:C").Select
    ActiveSheet.Range("$A$1:$C$1048259").AutoFilter Field:=3
    Selection.Copy
    Sheets("Produtos").Select
    Range("A1").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-12
    
    
    ActiveSheet.Range("A1:C1000").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
'---------s------------------------------------------
    
    Dim Produto As Range
    Set Produto = ThisWorkbook.Sheets("Produtos").[A2]
    
    
    While Produto <> ""
        Call CopiaProduto(Produto, Produto(1, 2))
        Set Produto = Produto(2)
    Wend

    
End Sub

Sub CopiaProduto(ByVal Produto As String, ByVal Template As String)
    Dim Area    As Range
    Dim Busca   As Range
    
    Set Area = ThisWorkbook.Sheets("Preenchendo_dados").[A1].CurrentRegion
    Call Area.AutoFilter(Field:=3, Criteria1:=Produto)
    Set Area = Area.Resize(Area.Rows.Count, 1)
    
    If Area.Offset(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Set Busca = ThisWorkbook.Sheets("TEMPLATE_PESO_MEDIDA").[B:B].Find( _
            What:=Template, LookIn:=xlValues, LookAt:=xlWhole)

        If Not Busca Is Nothing Then
            Set Area = Area.Resize( _
                Area.Rows.Count - 1, 1).Offset(1, 3).SpecialCells(xlCellTypeVisible)
            
            Busca.Resize(1, 42).Copy
            Area.PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    End If
    
    
    ActiveSheet.Range("$A$1:$C$349").AutoFilter Field:=3
     
     

End Sub

 

 

Sub TabFinal()

Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:A").Select
    Selection.Copy
    Columns("D:D").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D1").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("D2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Columns("A:A").EntireColumn.AutoFit

End Sub

 

 

A ideia seria ficar assim

 

 

 

mas ta ficando assim quando executo a macro 

 

 

[Scofieldgyn]

@isabela queiroz Anexe um excel com dados ficticios exemplificando como está de fato e como gostaria que ficasse. 

[isabela queiroz]

@Scofieldgyn acho que consegui resolver esse erro, era só questão de fazer a macro identificar onde ficava o filtro. mas surgiu outro problema, pode me ajudar? esta nesse topico aqui