Ir ao conteúdo
  • Cadastre-se

Excel Erro em tempo de execução 9


Posts recomendados

Boa tarde!

 

Galera,

 

Estou com o seguinte problema: A macro abaixo pega as informações de todas as guias da pasta de trabalho "Teste" e copia nas guias da Pasta de Trabalho "Teste1". Quando a pasta de trabalho "Teste1" encontra-se fechada, ela está executando as macros corretamente (Copiando infos da pasta Teste e colando na pasta Teste1), porém, cisma em aparecer ERRO EM TEMPO DE EXECUÇÃO 9 / SUBSCRITO FORA DO INTERVALO.

OBS.: Os nomes estão batendo, tanto que está copiando e colando todas as informações, acredito que seja um problema de variável ou leitura, mas estou procurando a tanto tempo, e não consegui encontrar nada na internet.

 

Abaixo segue os códigos para melhor visualização do problema.

 

 

 

Sub TestFileOpened()

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'Declarando todas as variáveis de origem e destino possíveis
Dim Ender1 As Worksheet
Dim Ender2 As Worksheet
Dim Ender3 As Worksheet
Dim Ender4 As Worksheet
Dim Ender5 As Worksheet
Dim Ender6 As Worksheet
Dim Ender7 As Worksheet
Dim Ender8 As Worksheet

'Função "SE" atrelada a uma função que encontra-se abaixo dessa Sub, onde faz a seguinte leitura:Se a planilha localizada no endereço abaixo (planilha Teste1) estiver aberta ela não abre novamente, apenas copia os dados a serem transferidos, porém, caso a planilha esteja fechada (nesse caso os comandos estão no Else) ela abre a planilha, tranfere os dados, salva e fecha.
If IsFileOpen("M:\Negocios\PLANILHAS\Teste1.xlsm") Then

'Declarando quais são as planilhas de origem e destino, assim como as guias a serem utilizadas
Set Ender1 = Workbooks("Teste.xlsm").Worksheets("Plan1")
Set Ender2 = Workbooks("Teste.xlsm").Worksheets("Plan2")
Set Ender3 = Workbooks("Teste.xlsm").Worksheets("Plan3")
Set Ender4 = Workbooks("Teste.xlsm").Worksheets("Plan4")

Set Ender5 = Workbooks("Teste1.xlsm").Worksheets("Plan1")
Set Ender6 = Workbooks("Teste1.xlsm").Worksheets("Plan2")
Set Ender7 = Workbooks("Teste1.xlsm").Worksheets("Plan3")
Set Ender8 = Workbooks("Teste1.xlsm").Worksheets("Plan4")

Ender1.Columns("A:AZ").Copy
Ender5.Range("A1").PasteSpecial
Application.CutCopyMode = False

Ender2.Columns("A:AZ").Copy
Ender6.Range("A1").PasteSpecial
Application.CutCopyMode = False

Ender3.Columns("A:AZ").Copy
Ender7.Range("A1").PasteSpecial
Application.CutCopyMode = False

Ender4.Columns("A:AZ").Copy
Ender8.Range("A1").PasteSpecial
Application.CutCopyMode = False


Else

Workbooks.Open filename:= _
    "M:\Negocios\PLANILHAS\Teste1.xlsm"

'Declarando quais são as planilhas de origem e destino, assim como as guias a serem utilizadas

Set Ender1 = Workbooks("Teste.xlsm").Worksheets("Plan1")
Set Ender2 = Workbooks("Teste.xlsm").Worksheets("Plan2")
Set Ender3 = Workbooks("Teste.xlsm").Worksheets("Plan3")
Set Ender4 = Workbooks("Teste.xlsm").Worksheets("Plan4")

Set Ender5 = Workbooks("Teste1.xlsm").Worksheets("Plan1")<<<<<<<<<<<<<<Erro em tempo de execução 9>>>>>>>>>>>>>>>
Set Ender6 = Workbooks("Teste1.xlsm").Worksheets("Plan2")
Set Ender7 = Workbooks("Teste1.xlsm").Worksheets("Plan3")
Set Ender8 = Workbooks("Teste1.xlsm").Worksheets("Plan4")

 

Ender1.Columns("A:AZ").Copy
Ender5.Range("A1").PasteSpecial
Application.CutCopyMode = False

Ender2.Columns("A:AZ").Copy
Ender6.Range("A1").PasteSpecial
Application.CutCopyMode = False

Ender3.Columns("A:AZ").Copy
Ender7.Range("A1").PasteSpecial
Application.CutCopyMode = False

Ender4.Columns("A:AZ").Copy
Ender8.Range("A1").PasteSpecial
Application.CutCopyMode = False


Workbooks("Teste1.xlsm").Close SaveChanges:=True
End If

ThisWorkbook.Save


'Código para não aparecer alerta se deseja salvar as informações em cima de outras informações que já constavam na planilha
 Application.DisplayAlerts = True

Application.ScreenUpdating = True
'Obs.: Essa macro roda automaticamente sempre que é salvo algo nessa planilha sendo que a chamada da macro esta em EstaPasta_de_trabalho

End Sub

________________________________________________________________________________________________________________________________

Function IsFileOpen(filename As String)
'Essa função está atrelada ao "If IsfileOpen" no qual ela verifica se a planilha de destino já encontra-se aberta, não havendo a necessidade de abri-la novamente

    Dim filenum As Integer, errnum As Integer
    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
    Select Case errnum
        Case 0
         IsFileOpen = False
        Case 70
            IsFileOpen = True
        Case Else
            Error errnum
    End Select
End Function

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!