none
Consolidar Planilhas (Células Visíveis) RRS feed

  • Pergunta

  • Bom dia!

    Possuo o seguinte script em VBA:

    Sub ConsolidarRetornos()


    Dim ulinha, i As Variant

    Application.DisplayAlerts = False

    Dirname = ActiveWorkbook.Path
    EsteArq = ActiveWorkbook.Name
    Sheets("Lista_Arquivos").Select

    Cells(4, 3).Select
    ulinha = Selection.End(xlDown).Row
       
    Workbooks("Consolidar").Sheets(3).Range("C4:V1048576").Clear
              
    For i = 4 To ulinha
    Windows("Consolidar").Activate
    Sheets("Lista_Arquivos").Select
    nomearq = Cells(i, 3).Value

          
    Workbooks.Open Filename:=Dirname & "\" & nomearq
    Windows(nomearq).Activate
    plans = Workbooks(nomearq).Worksheets.Count

    Windows("Consolidar").Activate
    Sheets(3).Select
    Range("C2").Select
    Linha = Selection.End(xlDown).Row + 1

    Workbooks("Consolidar").Activate

    For n = 3 To plans
        lin = 4
        Do Until Workbooks(nomearq).Sheets(n).Cells(lin, 3) = ""
          
            
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 3) = Workbooks(nomearq).Sheets(n).Cells(lin, 3)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 4) = Workbooks(nomearq).Sheets(n).Cells(lin, 4)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 5) = Workbooks(nomearq).Sheets(n).Cells(lin, 5)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 6) = Workbooks(nomearq).Sheets(n).Cells(lin, 6)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 7) = Workbooks(nomearq).Sheets(n).Cells(lin, 7)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 8) = Workbooks(nomearq).Sheets(n).Cells(lin, 8)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 9) = Workbooks(nomearq).Sheets(n).Cells(lin, 9)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 10) = Workbooks(nomearq).Sheets(n).Cells(lin, 10)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 11) = Workbooks(nomearq).Sheets(n).Cells(lin, 11)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 12) = Workbooks(nomearq).Sheets(n).Cells(lin, 12)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 13) = Workbooks(nomearq).Sheets(n).Cells(lin, 13)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 14) = Workbooks(nomearq).Sheets(n).Cells(lin, 14)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 15) = Workbooks(nomearq).Sheets(n).Cells(lin, 15)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 16) = Workbooks(nomearq).Sheets(n).Cells(lin, 16)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 17) = Workbooks(nomearq).Sheets(n).Cells(lin, 17)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 18) = Workbooks(nomearq).Sheets(n).Cells(lin, 18)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 19) = Workbooks(nomearq).Sheets(n).Cells(lin, 19)
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 20) = Workbooks(nomearq).Sheets(n).Cells(lin, 20)
       
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 22).Font.ColorIndex = n + 1
           Workbooks("Consolidar").Sheets(3).Cells(Linha, 22) = Workbooks(nomearq).Sheets(n).Name
          
           lin = lin + 1
                   
           Linha = Linha + 1
          
           
        Loop

        
       
        Next

    Workbooks(nomearq).Close SAVECHANGES:=True
    Application.DisplayAlerts = True


        Next i

    End Sub

    Basicamente, este código realiza a consolidação de todas as Sheets de um Workbook em apenas uma Sheet.

    O problema é que dentro das Sheets que serão consolidadas esta aplicado o AutoFiltro (AutoFilter) e quero apenas as informações visíveis.

    Por favor, alguém poderia me dar uma ajuda?

    Valew pessoal!


    quarta-feira, 28 de agosto de 2013 12:49

Respostas

  • acrescente, dentro do Do Until, um comando If para testar se a linha está oculta.
    exemplo:

    Do Until Workbooks(nomearq).Sheets(n).Cells(lin, 3) = ""
         If Not Cells(lin, 3).EntireRow.Hidden then
                 'Seus comandos
         End If
         lin = lin + 1
         Linha = Linha + 1
     Loop


    []s JLM Santo André - SP

    quarta-feira, 28 de agosto de 2013 16:15

Todas as Respostas

  • acrescente, dentro do Do Until, um comando If para testar se a linha está oculta.
    exemplo:

    Do Until Workbooks(nomearq).Sheets(n).Cells(lin, 3) = ""
         If Not Cells(lin, 3).EntireRow.Hidden then
                 'Seus comandos
         End If
         lin = lin + 1
         Linha = Linha + 1
     Loop


    []s JLM Santo André - SP

    quarta-feira, 28 de agosto de 2013 16:15
  • Obrigado JLMart!

    Inclui a instrução

     If Workbooks(nomearq).Sheets(n).Rows(lin).Hidden = False Then

    'Comandos

    End If

    lin = lin + 1

    Linha = Linha + 1

    Loop

    Funcionou corretamente. Copiou somente as células que estão visíveis.

    Valew, um abraço!

    sexta-feira, 30 de agosto de 2013 17:43