Achei em uma das postagens do forum, uma macro que atende parcialmente. Ela deixa eu selecionar a pasta onde estão os arquivos e realiza a importação de todos os arquivos que lá estão. Só que quando executo ela esta sobrescrevendo o conteúdo, ela sempre cola os dados no range A:H eu preciso que ela cole sequencialmente os dados da primeira planilha em A:H da planilha destino o da segunda em I:P e assim por diante também preciso que ele cole o nome da planilha de origem na célula "A13" para o primeiro arquivo, na célula I13 para o segundo e assim por diante.
O código é esse:
Sub ImportarVariosArquivos()
Dim Pasta As String
Dim Arquivo As String
'Habilita a captura de erros
On Error GoTo ERRO
'Abre caixa de diálogo para selecionar a pasta onde estão os arquivos a serem importados
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
Pasta = .SelectedItems(1)
End With
'Lista o primeiro arquivo a ser importado
Arquivo = Dir(Pasta & "" & "*.xl*")
'Laço para abrir cada um dos arquivos
Do
'Antes de abrir verifica se o arquivo não é o próprio (macro)
If Arquivo <> ThisWorkbook.Name Then
'Abre o arquivo
Workbooks.Open Pasta & "" & Arquivo
Sheets("3 - Resultados-Produtos").Select
'Copia o conteúdo para a primeira linha vazia
ActiveSheet.Range("A1:H120" & ActiveSheet.[A1].CurrentRegion.Rows.Count).Copy _
ThisWorkbook.Sheets("Importar").Range("A:H" & ThisWorkbook.Sheets("Importar").[A1].CurrentRegion.Rows.Count + 1)
'Fecha o arquivo
Workbooks(Arquivo).Close False
End If
'Lista cada um dos demais arquivos da pasta
Arquivo = Dir
Loop While Arquivo <> ""
Columns("A:H").AutoFit
MsgBox "Fim de Importação dos arquivos"
Exit Sub
ERRO:
MsgBox "Houve o seguinte erro na importação dos arquivos: " & vbLf & vbLf _
& "Código do Erro: " & Err.Number & vbLf & "Descrição: " & Err.Description, vbCritical, "Erro na Execução da Macro"
Exit Sub
End Sub
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 25/10/2017 6:54 am