Ir ao conteúdo

Posts recomendados

Postado

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

 image.png.288e681c98ed55b31ed0a392dde743af.png

 

 

mas ta ficando assim quando executo a macro 

image.png.1770a91daf679792a239c386727b8f72.png

 

 

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!