Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Loop de pesquisa em várias planilhas

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Tractive
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Sáb Set 29, 2018 12:17 am

Loop de pesquisa em várias planilhas

Mensagem por Tractive »

Olá pessoal, boa noite!

Preciso de uma ajuda, tenho uma situação onde na planilha "relatório" tenho uma relação de ativos na qual preciso realizar uma busca por ativo, dentre as planilhas "dados" para identificar as informações e posteriormente copiar as informações localizadas e colar numa sheet separada na planilha "relatório".

Até então elaborei o seguinte código:

Código: Selecionar todos

Sub importar_dados()

Application.ScreenUpdating = False

Dim wsDestino       As Worksheet
Dim wsOrigem        As Workbook
Dim wsArquivo       As Variant
Dim wsLoop          As Integer
Dim wsNomeArquivo   As String
Dim wsLinhaFinal    As Long
Dim wsBaseDados     As Worksheet
Dim wsLinha         As Long

'Loop dos arquivos

wsArquivo = Application.GetOpenFilename("Arquivo do Excel (*.xls), *.xl*", _
            Title:="Escolha o arquivo a ser importado", _
            MultiSelect:=True)
            
If Not IsArray(wsArquivo) Then
    If wsArquivo = "" Or wsArquivo = False Then
      MsgBox "Processo abortado, nenhum arquivo foi escolhido", vbOKOnly, "Processo abortado"
      Exit Sub
    End If
End If

    Set wsDestino = Sheets("NF")
    Set wsBaseDados = Sheets("AR_Jan")

'Loop para importação dos arquivos

For wsLoop = LBound(wsArquivo) To UBound(wsArquivo)

  wsLinha = 3
  wsNomeArquivo = wsArquivo(wsLoop)
      
  Application.Workbooks.Open (wsNomeArquivo)
  Set wsOrigem = ActiveWorkbook
     With wsOrigem
          wsUltimaLinha = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1

        While wsBaseDados.Range("A" & wsLinha).Value <> Empty
            wsLinhaFinal = wsDestino.Cells(Rows.Count, "B").End(xlUp).Row + 2
            ActiveSheet.Range("$B$2:$D$" & wsUltimaLinha).AutoFilter Field:=1, Criteria1:=wsBaseDados.Range("A" & wsLinha)
                    
                    ActiveSheet.Range("$B$2:$D$" & wsUltimaLinha).AutoFilter Field:=1, Criteria1:=wsBaseDados.Range("A" & wsLinha)
                    ActiveSheet.Range("$B$2:$AG$2").Select
                    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
                    Selection.SpecialCells(xlCellTypeVisible).Select
                    Selection.Copy
                    
                    wsDestino.Range("B" & wsLinhaFinal).PasteSpecial xlPasteValues
            
                    wsLinha = wsLinha + 1
                    
                    wsOrigem.ActiveSheet.Range("$B$2:$D$" & wsUltimaLinha).AutoFilter Field:=1
            
        Wend

  End With
  
  Application.DisplayAlerts = False
  
    ActiveWorkbook.Close savechanges:=False
   
  Application.DisplayAlerts = True

  
Next wsLoop

wsBaseDados.Range("B1").Select

MsgBox "Importação concluída"

Application.ScreenUpdating = True


End Sub

No entanto, não estou conseguindo realizar uma condição onde, se no arquivo "dados" não for localizado o ativo, deve pular para o próximo da sequência.

Poderiam me auxiliar? Os arquivos para testes encontram-se em anexo.
Anexos
arquivos.zip
(439.38 KiB) Baixado 263 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder