- 20 Nov 2019 às 08:42
#50405
Olá!
Adaptei uma macro para selecionar uma planilha, abri-la e copiar a plan1 para a plan1 de outra planilha (será copiado sempre para "Requisição ao Compras (AbrirArquivo3).xlsm").
Já tentei resolver mas dá erro em tempo de execução 9: Subscrito fora do intervalo.
A linha que dá erro é:
Set wsOrigem = Workbooks(lArquivo).Worksheets(Plan1)
A planilha roda para selecionar o arquivo e abrir mas daí tranca no erro.
Desde já agradeço pela atenção.
Segue o código completo
Sub lsSelecionarArquivo()
Dim fDlg As FileDialog
Dim lArquivo As String
Dim wsOrigem As Workbook
Dim wsDestino As Workbook
'Chama o objeto passando os parâmetros
Set fDlg = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
With fDlg
'Alterar esta propriedade para True permitirá a seleção de vários arquivos
.AllowMultiSelect = False
'Determina a forma de visualização dos aruqivos
.InitialView = msoFileDialogViewDetails
'Filtro de arquivos, pode ser colocado mais do que um filtro separando com ; por exemplo: "*.xls;*.xlsm"
.Filters.Add "All files", "*.*"
'Determina qual o drive inicial
.InitialFileName = "C:\"
End With
'Retorna o arquivo selecionado
If fDlg.Show = -1 Then
lArquivo = fDlg.SelectedItems(1)
MsgBox "O arquivo selecionado está em: " & lArquivo
'Especifica o caminho do arquivo de origem.
Workbooks.Open Filename:=lArquivo
'Especifica o nome e a aba do arquivo de origem, que deseja copiar os dados.
Set wsOrigem = Workbooks(lArquivo).Worksheets(Plan1)
'Especifica a aba no arquivo de destino, que deseja colar os dados.
Set wsDestino = Workbooks("Requisição ao Compras (AbrirArquivo3).xlsm").Worksheets(Plan1)
'Realiza o procedimento de copiar e colar os dados, no intervalo que desejar. Neste caso está sendo copiado todos os dados da planilha, exceto a primeira linha.
With wsOrigem
Cells.Select.Copy Destination:=wsDestino.Range("A1:CU8800")
End With
Else
MsgBox "Não foi selecionado nenhum arquivo"
End If
End Sub
Adaptei uma macro para selecionar uma planilha, abri-la e copiar a plan1 para a plan1 de outra planilha (será copiado sempre para "Requisição ao Compras (AbrirArquivo3).xlsm").
Já tentei resolver mas dá erro em tempo de execução 9: Subscrito fora do intervalo.
A linha que dá erro é:
Set wsOrigem = Workbooks(lArquivo).Worksheets(Plan1)
A planilha roda para selecionar o arquivo e abrir mas daí tranca no erro.
Desde já agradeço pela atenção.
Segue o código completo
Sub lsSelecionarArquivo()
Dim fDlg As FileDialog
Dim lArquivo As String
Dim wsOrigem As Workbook
Dim wsDestino As Workbook
'Chama o objeto passando os parâmetros
Set fDlg = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
With fDlg
'Alterar esta propriedade para True permitirá a seleção de vários arquivos
.AllowMultiSelect = False
'Determina a forma de visualização dos aruqivos
.InitialView = msoFileDialogViewDetails
'Filtro de arquivos, pode ser colocado mais do que um filtro separando com ; por exemplo: "*.xls;*.xlsm"
.Filters.Add "All files", "*.*"
'Determina qual o drive inicial
.InitialFileName = "C:\"
End With
'Retorna o arquivo selecionado
If fDlg.Show = -1 Then
lArquivo = fDlg.SelectedItems(1)
MsgBox "O arquivo selecionado está em: " & lArquivo
'Especifica o caminho do arquivo de origem.
Workbooks.Open Filename:=lArquivo
'Especifica o nome e a aba do arquivo de origem, que deseja copiar os dados.
Set wsOrigem = Workbooks(lArquivo).Worksheets(Plan1)
'Especifica a aba no arquivo de destino, que deseja colar os dados.
Set wsDestino = Workbooks("Requisição ao Compras (AbrirArquivo3).xlsm").Worksheets(Plan1)
'Realiza o procedimento de copiar e colar os dados, no intervalo que desejar. Neste caso está sendo copiado todos os dados da planilha, exceto a primeira linha.
With wsOrigem
Cells.Select.Copy Destination:=wsDestino.Range("A1:CU8800")
End With
Else
MsgBox "Não foi selecionado nenhum arquivo"
End If
End Sub