Excel vba - copiando varias colunas

[isabela queiroz]

Boa Tarde! Precisava copiar 3 colunas do  "Sheets1" e colar no "sheets2", porém a parte do codigo que não estou sabendo fazer é, que quando colar as colunas no outro sheets eles precisam ir com outro nome..

 

Ex. no exemplo encaminhado a coluna "nomes" por exemplo, no "sheet2" fica como "Nom Pessoa", a ideia seria achar as 3 colunas no sheet1, fazer elas se localizarem no sheet2 onde devem ficar cada uma e depois colar cada uma das colunas de informações no seu respectivo local.

 

em outro codigo eu usei  um codigo mais ou menos assim 

'-------------------------------------------------------------------------------
Sub CopiaColaColunas()

  Dim rTbl As Range, rTot As Range, rTmp As Range, nomes As Variant, nome As Variant
  nomes = Array("level", "item number", "item name", "revision", "unit of measure", "quantity")
  
  Set rTbl = Workbooks("20.0470.xlsx").Worksheets("20.0470").[A12].CurrentRegion
  For Each nome In nomes
    Set rTmp = Intersect(rTbl, rTbl.Rows(1).Find(What:=nome, LookAt:=xlWhole).EntireColumn)
    If rTot Is Nothing Then Set rTot = rTmp Else Set rTot = Union(rTot, rTmp)
  
  Next nome
  rTot.Copy Destination:=Workbooks("MACRO.xlsm").Worksheets("Sheet2").[A1]
  Application.CutCopyMode = False

End Sub

EXEMPLO_CLUB.xlsx

[Midori]

@isabela queiroz Você pode mais arranjos para armazenar os nomes das colunas de origem , destino e as linhas onde tem os nomes das colunas.

 

A função CopiaColunas recebe esses argumentos, junto com a quantidade de linhas que devem ser copiadas, nesse caso são 5. O nome de algumas colunas na sua planilha tem espaço no final, então remova antes de testar,

 

Sub Macro()
    Call CopiaColunas( _
        Array("nomes", "numero", "digito"), _
        Array("Nom Pessoas", "Num. Cod", "Customer"), _
        Array(Sheets("Sheet1").[1:1], Sheets("Sheet2").[2:2]), 5)
End Sub

Sub CopiaColunas(OrigNomes As Variant, DestNomes As Variant, Linhas As Variant, Conta As Long)
    Dim ProcOrig    As Range
    Dim ProcDest    As Range
    Dim Indice      As Integer
    
    For Indice = 0 To UBound(OrigNomes)
        Set ProcOrig = Linhas(0).Find( _
            What:=OrigNomes(Indice), LookIn:=xlValues, LookAt:=xlWhole)
        
        If Not ProcOrig Is Nothing Then
            Set ProcDest = Linhas(1).Find( _
                What:=DestNomes(Indice), LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not ProcDest Is Nothing Then
                Call ProcOrig.Offset(1).Resize(Conta).Copy(ProcDest.Offset(1))
            End If
        End If
    Next Indice
End Sub

 

[isabela queiroz]

@Midori Obrigada! Funcionou perfeitamente. Mas só pra saber, tem como fazer sem limite de linhas? fazer a macro ir ate a ultima linha preenchida (essas celulas que estavam em branco no exemplo foi erro meu, na planilha original todas vão estar preenchidas)

 

E eu precisava que copiasse apenas o que esta visivel das colunas (no caso com filtro)

 

pensei em fazer assim mas obviamente o codigo não funcionou, eu sei a função mas não sei onde colocar ela 

 

Sub Macro()

Dim ul As String
ul = Cells(Rows.Count, 1).End(x1Up).Row 

    Call CopiaColunas( _
        Array("nomes", "numero", "digito"), _
        Array("Nom Pessoas", "Num. Cod", "Customer"), _
        Array(Sheets("Sheet1").[1:1], Sheets("Sheet2").[2:2]), "ul")
End Sub

 

[Midori]

@isabela queiroz Para copiar todas o parâmetro Conta pode ser removido para a atribuição ficar no próprio procedimento,

 

Sub CopiaColunas(OrigNomes As Variant, DestNomes As Variant, Linhas As Variant)
    Dim ProcOrig    As Range
    Dim ProcDest    As Range
    Dim Indice      As Integer
    Dim Conta       As Long
    
    If Linhas(0).Cells(1, 1).Offset(1) <> "" Then
        Conta = Linhas(0).End(xlDown).Row - 1
        
        For Indice = 0 To UBound(OrigNomes)
            Set ProcOrig = Linhas(0).Find( _
                What:=OrigNomes(Indice), LookIn:=xlValues, LookAt:=xlWhole)
        
            If Not ProcOrig Is Nothing Then
                Set ProcDest = Linhas(1).Find( _
                    What:=DestNomes(Indice), LookIn:=xlValues, LookAt:=xlWhole)
                    
                If Not ProcDest Is Nothing Then
                    Call ProcOrig.Offset(1).Resize(Conta).Copy(ProcDest.Offset(1))
                End If
            End If
        Next Indice
    End If
End Sub

 

1 hora atrás, isabela queiroz disse:

pensei em fazer assim mas obviamente o codigo não funcionou, eu sei a função mas não sei onde colocar ela 

 

Também dá para fazer assim, mas o tipo de ul deve ser Long assim como o argumento passado para a sub.

 

Em xlUp você acabou trocando l pelo número 1.

[isabela queiroz]

@Midori quando dou start isso acontece   o codigo fica assim?

Sub Macro()
    Call CopiaColunas( _
        Array("nomes", "numero", "digito"), _
        Array("Nom Pessoas", "Num. Cod", "Customer"), _
        Array(Sheets("Sheet1").[1:1], Sheets("Sheet2").[2:2]), 5)
End Sub

Sub CopiaColunas(OrigNomes As Variant, DestNomes As Variant, Linhas As Variant)
    Dim ProcOrig    As Range
    Dim ProcDest    As Range
    Dim Indice      As Integer
    Dim Conta       As Long
    
    If Linhas(0).Cells(1, 1).Offset(1) <> "" Then
        Conta = Linhas(0).End(xlDown).Row - 1
        
        For Indice = 0 To UBound(OrigNomes)
            Set ProcOrig = Linhas(0).Find( _
                What:=OrigNomes(Indice), LookIn:=xlValues, LookAt:=xlWhole)
        
            If Not ProcOrig Is Nothing Then
                Set ProcDest = Linhas(1).Find( _
                    What:=DestNomes(Indice), LookIn:=xlValues, LookAt:=xlWhole)
                    
                If Not ProcDest Is Nothing Then
                    Call ProcOrig.Offset(1).Resize(Conta).Copy(ProcDest.Offset(1))
                End If
            End If
        Next Indice
    End If
End Sub

 

23 minutos atrás, isabela queiroz disse:

Sub CopiaColunas(OrigNomes As Variant, DestNomes As Variant, Linhas As Variant)
    Dim ProcOrig    As Range
    Dim ProcDest    As Range
    Dim Indice      As Integer
    Dim Conta       As Long

achei o erro, precisava ficar assim

Sub CopiaColunas(OrigNomes As Variant, DestNomes As Variant, Linhas As Variant, Conta As Long)
	Dim ProcOrig    As Range
    Dim ProcDest    As Range
    Dim Indice      As Integer

 

Mas ainda assim o Codigo roda mas não esta copiando apenas as filtradas, ta vindo tudo junto

[Midori]

1 hora atrás, isabela queiroz disse:

Mas ainda assim o Codigo roda mas não esta copiando apenas as filtradas, ta vindo tudo junto

Testei aqui e copiou só as filtradas. Está rodando em outra planilha com mais dados ou na que anexou aqui?

[isabela queiroz]

@Midori em outra planilha, tem muitas linhas nessa outra, mas testei antes com um numero menor de conteudo e ainda copiou as não filtradas tambem..

 

Agora tentei mais uma vez e deu certo! Não sei porque não tinha funcionado, muito obrigada

 

[Midori]

@isabela queiroz Tenta fazer outro teste nessa que anexou aqui. Abra novamente essa sem edição.

[isabela queiroz]

@Midori tem como tirar a formatação das colunas quando copiar elas?

[Midori]

@isabela queiroz Tem com PasteSpecial em vez de colar com Copy, p.ex,

Call ProcOrig.Offset(1).Resize(Conta).Copy
Call ProcDest.Offset(1).PasteSpecial(xlPasteValues)

 

[isabela queiroz]

@MidoriAh fiz aqui, muito obrigada, ajudou demais!