Página 1 de 1

macro pular planilha se não encontrada.

Enviado: Qui Mai 16, 2019 9:43 am
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

Re: macro pular planilha se não encontrada.

Enviado: Qui Mai 16, 2019 2:13 pm
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......

Re: macro pular planilha se não encontrada.

Enviado: Qui Mai 16, 2019 2:34 pm
por esbsbarbieri
Cara SENSACIONAL!!!

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

Re: macro pular planilha se não encontrada.

Enviado: Qui Mai 16, 2019 2:48 pm
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!

Re: macro pular planilha se não encontrada.

Enviado: Qui Mai 16, 2019 10:57 pm
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
........

Re: macro pular planilha se não encontrada.

Enviado: Ter Mai 28, 2019 4:20 pm
por esbsbarbieri
Reinaldo, muito obrigado!