Esqueceu sua senha? Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

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

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

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......


Reinaldo
Gostou da resposta?:?: :oops: :D :mrgreen:

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 » Qui Mai 16, 2019 2:34 pm

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

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

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
........


Reinaldo
Gostou da resposta?:?: :oops: :D :mrgreen:

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 » Ter Mai 28, 2019 4:20 pm

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