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

Ir em baixo

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

Mensagem por alexandrevba em 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
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