Página 1 de 1

VBA Extrair Relatório com Critério e Formulário

Enviado: 11 Ago 2016 às 20:50
por refernande
Boa Noite
Estou tentando concluir uma planilha mais estou tendo problema para extrair o relatório com formulário.
Estou utilizando 3 critérios mais somente o primeiro não está extraindo, os 2 e 3 extra extraindo normalmente.
Vou encaminhar a planilha para alguém me dar apoio.

Re: VBA Extrair Relatório com Critério e Formulário

Enviado: 12 Ago 2016 às 09:37
por alexandrevba
Bom dia!!

Porque simplesmente não filtra os dados e depois copia para guia desejada?
Código: Selecionar todos
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    With Sheets("PQ").UsedRange.Offset(1)
        .AutoFilter
        If Cd_Status.ListIndex > -1 Then .AutoFilter 2, Cd_Status.Value
        If CdRp.ListIndex > -1 Then .AutoFilter 3, CdRp.Value
        If CdSegmento.ListIndex > -1 Then .AutoFilter 5, CdSegmento.Value
        'Depois copia os dados filtrados para outra guia?
    End With
    Application.ScreenUpdating = True
End Sub
Att

Re: VBA Extrair Relatório com Critério e Formulário

Enviado: 12 Ago 2016 às 14:36
por refernande
Certo
Mais como estou extraindo somente algumas colunas não teria problema?
Manda a planilha que vc fez a modificação.
Pois sou leigo a respeito de vba.

Att

Re: VBA Extrair Relatório com Critério e Formulário

Enviado: 15 Ago 2016 às 13:09
por alexandrevba
Boa tarde!
Tente
Código: Selecionar todos
Private Sub CB_Gerar_Click()
Dim Lr As Long
    Application.ScreenUpdating = False
    Lr = Sheets("PQ").Range("B" & Rows.Count).End(xlUp).Row
    With Sheets("PQ").UsedRange.Offset(1)
        .AutoFilter
        If Cd_Status.ListIndex > -1 Then .AutoFilter 2, Cd_Status.Value
        If CdRp.ListIndex > -1 Then .AutoFilter 3, CdRp.Value
        If CdSegmento.ListIndex > -1 Then .AutoFilter 5, CdSegmento.Value
        'Depois copia os dados filtrados para outra guia?
        'Range("A2", Range("A" & Rows.Count).End(xlUp))
        .Range("H5:H" & Lr).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("ATIVIDADE").Range("C" & Rows.Count).End(xlUp).Offset(1)
        .Range("I5:I" & Lr).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("ATIVIDADE").Range("D" & Rows.Count).End(xlUp).Offset(1)
        .Range("M5:M" & Lr).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("ATIVIDADE").Range("E" & Rows.Count).End(xlUp).Offset(1)
        .Range("P5:P" & Lr).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("ATIVIDADE").Range("F" & Rows.Count).End(xlUp).Offset(1)
        .Range("V5:V" & Lr).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("ATIVIDADE").Range("G" & Rows.Count).End(xlUp).Offset(1)
        .Range("S5:S" & Lr).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("ATIVIDADE").Range("H" & Rows.Count).End(xlUp).Offset(1)
        .Range("D5:D" & Lr).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("ATIVIDADE").Range("K" & Rows.Count).End(xlUp).Offset(1)
    End With

End Sub
Att