Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
macro pular planilha se não encontrada.
-
- Acabou de chegar
- Mensagens: 6
- Registrado em: Qui Mai 16, 2019 9:32 am
macro pular planilha se não encontrada.
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
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
- Reinaldo
- 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.
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
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......
-
- Acabou de chegar
- Mensagens: 6
- Registrado em: Qui Mai 16, 2019 9:32 am
Re: macro pular planilha se não encontrada.
Cara SENSACIONAL!!!
Agradeço muito sua ajuda. Não exagero que vc ajudou no meu emprego e minha efetivação!
Agradeço muito sua ajuda. Não exagero que vc ajudou no meu emprego e minha efetivação!
-
- Acabou de chegar
- Mensagens: 6
- Registrado em: Qui Mai 16, 2019 9:32 am
Re: macro pular planilha se não encontrada.
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!
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!
- Reinaldo
- 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.
Na clausula If, complete com o Else
e no Else "mande" escrever o nome do arquivo não encontrado
Algo =/- assim:
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
........
-
- Acabou de chegar
- Mensagens: 6
- Registrado em: Qui Mai 16, 2019 9:32 am