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

Filtrar varias Guias baseado 1 critério copiar os dados para 1 guia

Ir para baixo

Filtrar varias Guias baseado 1 critério copiar os dados para 1 guia Empty Filtrar varias Guias baseado 1 critério copiar os dados para 1 guia

Mensagem por alexandrevba Qua Dez 10, 2014 6:49 am

Bom dia!!

Código:
Sub AleVBA_FiltravariasGuiasParaGuia()
'Filtra baseado em um criterio na coluna A, em várias guias e copia para uma única guia ("Guia_Destino")
    Dim sh As Worksheet, ws As Worksheet
    Dim Rws As Long, Rng As Range, s As String

    Set ws = Worksheets("Guia_Destino")

    Application.ScreenUpdating = 0
    s = InputBox("Digite seu Critério")
    For Each sh In Sheets
        If sh.Name <> "Guia_Destino" Then

            With sh
                Rws = .Cells(Rows.Count, "A").End(xlUp).Row
                Set Rng = Range(.Cells(2, 1), .Cells(Rws, 4)) 'Copia de Col A até Col D
                .Range("A1").AutoFilter Field:=1, Criteria1:=s
                Rng.Copy ws.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Range("A1").AutoFilter
            End With

        End If

    Next sh

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