Inquiridor
Erro de execucao 9 - Subscrito fora do intervalo

Pergunta
-
Criei uma macro numa planilha consolidadora de dados de várias regiões de minha empresa chamadas DRs. A macro abrir as respectivas planilhas, copiar blocos localizados em abas específicas e, ao finalizar, inclui o trecho a seguir que ativa cada uma das planilhas abertas e as fecha sem salvar. Ao executar o VBA executa a primeira parte (copiar as tabelas), mas apresenta no final da subrotina a mensagem de "Erro de execução '9' - Subscrito fora do intervalo, parando a depuração no comando "Windows(Arq).Activate". Alguém pode indicar o que está errado?
Dim Arq As String
Dim Compl As String
Compl = ThisWorkbook.Path
Arq = Compl + "\" + "DR_"
DR = Array("03", "04", "05", "06", "08", "10", "12", "14", "16", "18", "20", "22")
i = 0
Do While i < 11
Arq = Arq + CStr(DR(i)) + ".xlsx"Windows(Arq).Activate
Application.DisplayAlerts = False
ThisWorkbook.Close
Application.DisplayAlerts = True
i = i + 1
Arq = Compl + "\" + "DR_"
Loop
Todas as Respostas
-
Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum. Uma janela aparecerá onde você deverá colar seu código cru na caixa de texto à esquerda. Então, selecione a opção Vb.Net na caixa de combinação que você verá em cima à esquerda e depois clique no botão Inserir.
---
Seu código está dando erro porque não encontra uma janela com o nome da variável "Arq".
Sugiro que acrescente a linha Debug.Print Arq antes da linha Windows(Arq).Activate para ver em qual valor dessa variável sua macro está falhando.
http://www.ambienteoffice.com.br - http://www.clarian.com.br
-
O erro ocorre já na execução do primeiro valor (i = 0) da variável Arq que é 'D:\ArquivosExcel\DR_03.XSLX'. Inicialmente, pensei tratar-se de falha do método Windows(Arq).Activate em reconhecer o valor da variável Arq, dado que o caminho onde estão as planilhas no servidor é muito extenso e com caracteres especiais 'ç' e 'ã'. Aí copiei a pasta para meu micro e continua com o mesmo erro.
-
Há código faltando na sua macro. Por exemplo: onde está o bloco de código que copia o conteúdo de uma planilha a outra? E o trecho que abre a pasta de trabalho?
Sugiro usar este suplemneto: http://www.rondebruin.nl/win/addins/rdbmerge.htm
http://www.ambienteoffice.com.br - http://www.clarian.com.br
-
Sub Roubo() ' ' Roubo Macro ' On Error GoTo ErrMsg Dim Arq As String Dim i As Integer Dim chkErro As Integer Dim Compl As String '============ Copiar conteúdo das palnilhas das DRs DR = Array("03", "04", "05", "06", "08", "10", "12", "14", "16", "18", "20", "22", "24", "26", "28", "30", "32", "34", "36", "50", "60", "64", "65", "68", "70", "72", "74", "75") DRsgl = Array("ACR", "AL", "AP", "AM", "BA", "BSB", "CE", "ES", "GO", "MA", "MG", "MS", "MT", "RO", "PA", "PB", "PE", "PI", "RJ", "RN", "RS", "RR", "SC", "SE", "SPM", "SPI", "TO") Compl = ThisWorkbook.Path Arq = Compl + "\" + "DR_" i = 0 chkErro = 0 Do While i < 2 Arq = Arq + CStr(DR(i)) + ".xlsx" ' If Dir(Arq) = vbNullString Then chkErro = 1 GoTo ErrMsg Else Workbooks.Open Filename:=Arq On Error GoTo ErrMsg Sheets("ROUBO").Select Range("A3:I3").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Windows("prejuízos_indenizar_ECT.xlsm").Activate Sheets("ROUBO").Select Range("A2:A2").Select Selection.End(xlDown).Select chkErro = 0 End If If i > 1 Then Selection.End(xlDown).Select End If ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste ErrMsg: If chkErro = 1 Then MsgBox ("Arquivo da DR " & CStr(DRsgl(i)) & " não localizado ou Aba Roubo inexistente"), , "Mensagem ausência de dados" chkErro = 0 End If Arq = Compl + "\" + "DR_" i = i + 1 Loop '========= Fechar todos os arquivos das DRs =============== Compl = ThisWorkbook.Path Arq = Compl + "\" + "DR_" DR = Array("03", "04", "05", "06", "08", "10", "12", "14", "16", "18", "20", "22", "24", "26", "28", "30", "32", "34", "36", "50", "60", "64", "65", "68", "70", "72", "74", "75") DRsgl = Array("ACR", "AL", "AP", "AM", "BA", "BSB", "CE", "ES", "GO", "MA", "MG", "MS", "MT", "RO", "PA", "PB", "PE", "PI", "RJ", "RN", "RS", "RR", "SC", "SE", "SPM", "SPI", "TO") i = 0 chkErro = 0 Do While i < 3 Arq = Arq + CStr(DR(i)) + ".xlsx" ' If Dir(Arq) = vbNullString Then chkErro = 1 GoTo ErrMsg1 Else MsgBox ("O nome do último arquivo aberto é " & Arq & " o número de ordem é " & i) Debug.Print Arq Windows(Arq).Activate Application.DisplayAlerts = False ThisWorkbook.Close Application.DisplayAlerts = True End If i = i + 1 Arq = Compl + "\" + "DR_" ErrMsg1: MsgBox ("Arquivo da DR " & CStr(DRsgl(i)) & " não localizado ou Aba Roubo inexistente"), , "Mensagem ausência de dados" Loop End Sub
-
-