Rotina pra pula sheet caso não tenha

2024 - VBA & Macros

Post Recente por klarc28 7 anos atrás

5 Posts

2 Usuários

0 Reactions

976 Visualizações

RSS

vitorhsh

(@vitorhsh)

Posts: 0

Trusted Member

Topic starter

Bom dia família,

Estou tentando criar uma rotina que pule uma sheet caso ela não venha na planilha
Ex, tenho uma planilha chama plan1 com 3 sheets aba 1, aba 2 e aba 3.
E uma rotina pra capturar os dados da plan1 e cola em outra plan vou chama de plan2, a rotina pra copia e cola e básica tá funcionando ela seta a plan1 vai na aba1 copia os dados da b12 e cola na plan2 após esse procedimento ela faz a mesma coisa nas outras sheets até aí tudo bem porém a plan1 poderá vim sem umas das abas nesse caso a rotina pra copia da erro porque não acha a sheet aba 2 nesse caso gostaria de uma função pra ela detectar que não existe a aba2 e pula para aba3 sem da erro preciso de um help desde-já agradecido

Att Vitor hugo

Postado : 24/01/2018 7:01 am

klarc28

(@klarc28)

Posts: 971

Prominent Member

Function LookupSheet(ByRef SheetName As String) As Boolean
On Error GoTo ErrControl
Dim objws As Worksheet
    
    LookupSheet = False
    For Each objws In ThisWorkbook.Worksheets
        If objws.Name = SheetName Then
            LookupSheet = True
            Exit For
        End If
    Next objws
    
Finally:
    Set objws = Nothing
    Exit Function

ErrControl:
    Call MsgBox("Erro ao localizar palnilha", Err.Description, "Funcao do Flavao")
    Resume Finally
    
End Function

Postado : 24/01/2018 7:52 am

klarc28

(@klarc28)

Posts: 971

Prominent Member

Não paga nada para postar código e anexar arquivo. Provavelmente você vai vir com mais uma dúvida, pois não ficou claro o que você queria. Se tivesse anexado o arquivo com o código seria muito mais ágil.

Postado : 24/01/2018 7:54 am

klarc28

(@klarc28)

Posts: 971

Prominent Member

Option Explicit

Function LookupSheet(ByRef SheetName As String) As Boolean
On Error GoTo ErrControl
Dim objws As Worksheet
    
    LookupSheet = False
    For Each objws In ThisWorkbook.Worksheets
        If objws.Name = SheetName Then
            LookupSheet = True
            Exit For
        End If
    Next objws
    
Finally:
    Set objws = Nothing
    Exit Function

ErrControl:
    Call MsgBox("Erro ao localizar palnilha", Err.Description, "Funcao do Flavao")
    Resume Finally
    
End Function

Sub teste()

If LookupSheet("Plan2") = True Then

MsgBox "Planilha encontrada"
Else
MsgBox "Planilha não encontrada"

End If
End Sub

Postado : 24/01/2018 7:58 am