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

macro pular planilha se não encontrada.

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
esbsbarbieri
Acabou de chegar
Acabou de chegar
Mensagens: 6
Registrado em: Qui Mai 16, 2019 9:32 am

macro pular planilha se não encontrada.

Mensagem por esbsbarbieri »

Pessoal, bom dia.

tenho a macro abaixo:

O que eu preciso é que, por exemplo, se a macro não encontrar a planilha Esbs (2), a macro continua, sem dar mensagem de erro ou travar.

Seria como ela "pular" a planilha se não encontrar e ir para próxima, e se ela encontrar, processo normal (abrir a planilha e "pegar" as infos que são requeridas). Podem me ajudar, por favor?


Sub Macro_Esbs ()

'Inicio códio EAN
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False

On Error Resume Next
Workbooks.Open Filename:= _
"C:\Users\esantos10\OneDrive - RBs\Documents\ABR\Meses\04 - abr - 19\Esbs (1) - abr19.xlsm"
Range("N5").Select
ActiveCell.FormulaR1C1 = "=CELL(""filename"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ultima = Range("D5").End(xlDown).Row
Range("N6:N" & ultima).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Windows("Esbs (1) - abr19.xlsm").Activate
Call PreencheZeros_1

ultima = Range("D5").End(xlDown).Row
Range("D5:D" & ultima).Select
Selection.Copy
Windows("DASH - macro").Activate
While ActiveCell.Text <> ""
ActiveCell.Offset(1, 0).Select
Wend
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Workbooks.Open Filename:= _
"C:\Users\esantos10\OneDrive - RBs\Documents\ABR\Meses\04 - abr - 19\Esbs (2) - abr19.xlsm"
Range("N5").Select
ActiveCell.FormulaR1C1 = "=CELL(""filename"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ultima = Range("D5").End(xlDown).Row
Range("N6:N" & ultima).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Windows("Esbs (2) - abr19.xlsm").Activate
Call PreencheZeros_1

ultima = Range("D5").End(xlDown).Row
Range("D5:D" & ultima).Select
Selection.Copy
Windows("DASH - macro").Activate
While ActiveCell.Text <> ""
ActiveCell.Offset(1, 0).Select
Wend
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Workbooks.Open Filename:= _
"C:\Users\esantos10\OneDrive - RBs\Documents\ABR\Meses\04 - abr - 19\Esbs (3) - abr19.xlsm"
Range("N5").Select
ActiveCell.FormulaR1C1 = "=CELL(""filename"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ultima = Range("D5").End(xlDown).Row
Range("N6:N" & ultima).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Windows("Esbs (3) - abr19").Activate
Call PreencheZeros_1

ultima = Range("D5").End(xlDown).Row
Range("D5:D" & ultima).Select
Selection.Copy
Windows("DASH - macro").Activate
While ActiveCell.Text <> ""
ActiveCell.Offset(1, 0).Select
Wend
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste


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.


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: macro pular planilha se não encontrada.

Mensagem por Reinaldo »

Uma possibilidade:
Crie uma variável tipo string.
Por Exemplo :Dim xT as string
Verifique se o arquivo existe -->
xT = Dir("C:\Users\esantos10\OneDrive - RBs\Documents\ABR\Meses\04 - abr - 19\Esbs (1) - abr19.xlsm")
Questione se xT e diferente vazio, se for executa rotina.
+/- assim

Código: Selecionar todos

Sub Macro_Esbs()
Dim xT As String

'Inicio códio EAN
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False

'Verifica arquivo
xT = Dir("C:\Users\esantos10\OneDrive - RBs\Documents\ABR\Meses\04 - abr - 19\Esbs (1) - abr19.xlsm")

If xT <> "" Then
    Workbooks.Open Filename:= _
    "C:\Users\esantos10\OneDrive - RBs\Documents\ABR\Meses\04 - abr - 19\Esbs (1) - abr19.xlsm"
    Range("N5").Select
    ActiveCell.FormulaR1C1 = "=CELL(""filename"")"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    ultima = Range("D5").End(xlDown).Row
    Range("N6:N" & ultima).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Windows("Esbs (1) - abr19.xlsm").Activate
    Call PreencheZeros_1
    
    ultima = Range("D5").End(xlDown).Row
    Range("D5:D" & ultima).Select
    Selection.Copy
    Windows("DASH - macro").Activate
    While ActiveCell.Text <> ""
    ActiveCell.Offset(1, 0).Select
    Wend
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
End If

'Verifica arquivo
xT = Dir("C:\Users\esantos10\OneDrive - RBs\Documents\ABR\Meses\04 - abr - 19\Esbs (2) - abr19.xlsm")

If xT <> "" Then
Workbooks.Open Filename:= _
"C:\Users\esantos10\OneDrive - RBs\Documents\ABR\Meses\04 - abr - 19\Esbs (2) - abr19.xlsm"
Range("N5").Select
ActiveCell.FormulaR1C1 = "=CELL(""filename"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ultima = Range("D5").End(xlDown).Row
Range("N6:N" & ultima).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Windows("Esbs (2) - abr19.xlsm").Activate
Call PreencheZeros_1

ultima = Range("D5").End(xlDown).Row
Range("D5:D" & ultima).Select
Selection.Copy
Windows("DASH - macro").Activate
While ActiveCell.Text <> ""
ActiveCell.Offset(1, 0).Select
Wend
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
end if......


esbsbarbieri
Acabou de chegar
Acabou de chegar
Mensagens: 6
Registrado em: Qui Mai 16, 2019 9:32 am

Re: macro pular planilha se não encontrada.

Mensagem por esbsbarbieri »

Cara SENSACIONAL!!!

Agradeço muito sua ajuda. Não exagero que vc ajudou no meu emprego e minha efetivação!


esbsbarbieri
Acabou de chegar
Acabou de chegar
Mensagens: 6
Registrado em: Qui Mai 16, 2019 9:32 am

Re: macro pular planilha se não encontrada.

Mensagem por esbsbarbieri »

Reinaldo,

sem querer abusar mas já abusando, seria possível listar os arquivos que não foram encontrados numa aba depois que rodar essa macro que você escreveu para mim?

No caso: não encontrou a Esbs (2), a macro que vc fez roda e numa outra aba esse arquivo não encontrado é listado. Tem como fazer isso?
Abs!


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.


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: macro pular planilha se não encontrada.

Mensagem por Reinaldo »

Na clausula If, complete com o Else
e no Else "mande" escrever o nome do arquivo não encontrado
Algo =/- assim:

Código: Selecionar todos

Sub Macro_Esbs()
Dim xT As String

'Inicio códio EAN
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False

'Verifica arquivo
xT = Dir("C:\Users\esantos10\OneDrive - RBs\Documents\ABR\Meses\04 - abr - 19\Esbs (1) - abr19.xlsm")

If xT <> "" Then
    Workbooks.Open Filename:= _
    "C:\Users\esantos10\OneDrive - RBs\Documents\ABR\Meses\04 - abr - 19\Esbs (1) - abr19.xlsm"
    Range("N5").Select
    ActiveCell.FormulaR1C1 = "=CELL(""filename"")"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    ultima = Range("D5").End(xlDown).Row
    Range("N6:N" & ultima).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Windows("Esbs (1) - abr19.xlsm").Activate
    Call PreencheZeros_1
    
    ultima = Range("D5").End(xlDown).Row
    Range("D5:D" & ultima).Select
    Selection.Copy
    Windows("DASH - macro").Activate
    While ActiveCell.Text <> ""
    ActiveCell.Offset(1, 0).Select
    Wend
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
else
    sheets("NomeDaSheet").range("A2").value="Arquivo Esbs (1) - abr19.xlsm não encontrado"
End If
........


esbsbarbieri
Acabou de chegar
Acabou de chegar
Mensagens: 6
Registrado em: Qui Mai 16, 2019 9:32 am

Re: macro pular planilha se não encontrada.

Mensagem por esbsbarbieri »

Reinaldo, muito obrigado!


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