Copiar dados baseado em cabeçalho de uma guia para outra guia

Ir em baixo

Copiar dados baseado em cabeçalho de uma guia para outra guia

Mensagem por alexandrevba em Sab Mar 08, 2014 2:54 pm

Boa tarde!!

Como copiar dados baseado em cabeçalho da guia 1 para a guia 2.
Código:

Sub CopiarBaseadoEmCabecalho()
    Application.ScreenUpdating = False
    Sheets("Sheet2").UsedRange.ClearContents
    Dim i As Long
    Dim lColumn As Long
    Dim Col
    Dim foundCol As Range
    Col = Array("Nome", "Valor")
    On Error Resume Next
    For i = 0 To UBound(Col)
        lColumn = Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column
        Set foundCol = Sheets("Sheet1").Rows(1).Find(Col(i), LookIn:=xlValues, LookAt:=xlWhole)
            If Not foundCol Is Nothing Then
                foundCol.EntireColumn.Copy Sheets("Sheet2").Cells(1, lColumn + 1)
            End If
    Next i
    Sheets("Sheet2").Columns(1).EntireColumn.Delete
    Application.ScreenUpdating = True
End Sub
Att
avatar
alexandrevba
Intermediário
Intermediário

Mensagens : 222
Data de inscrição : 26/06/2012
Localização : Serra-ES

Ver perfil do usuário

Voltar ao Topo Ir em baixo

Voltar ao Topo

- Tópicos similares

 
Permissão deste fórum:
Você não pode responder aos tópicos neste fórum