Usuários do Excel
Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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

Ir para baixo

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

Mensagem por alexandrevba Sáb 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
alexandrevba
alexandrevba
Intermediário
Intermediário

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

Ir para o topo Ir para baixo

Ir para o topo

- Tópicos semelhantes

 
Permissões neste sub-fórum
Não podes responder a tópicos