Seleccionar datos de diferentes archivos de excel
Tengo un macro que me permite seleccionar un archivo, la cuestion es que quiero tomar unas celdas de ese archivo para pasarlos a otro y eso lo debo hacer con todos los archivos de una carpeta, las celdas son fijas para todos los archivos, tanto en el origen como en el destino. He intentado varias cosas pero al final no me funcionan.
¿Alguna ayuda? Me urge.
Ya me hice bolas y no se en donde colocar lo que necesito.
Sub Obtener_datos()
Dim fila As Long
Dim Ruta_elegida, Nombre_archivo, Ruta_inicial
Ruta_inicial = "C:\"
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Selecciona un archivo"
.InitialFileName = Ruta_inicial
.Show
If .SelectedItems.Count <> 0 Then
Ruta_elegida = .SelectedItems(1) & "\"
Nombre_archivo = Dir(Ruta_elegida)
Do While Nombre_archivo <> ""
Cells(4, 3).Offset(fila) = Nombre_archivo
fila = fila + 1
Nombre_archivo = Dir
Loop
End If
End With
End Sub
Te anexo la macro para copiar un rango de celdas, de igual forma completa la información faltante.
Sub Copiar_Un_Rango()
'---
' Por.Dante Amor
'---
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja10") 'hoja destino
col = "A" 'columna destino
rango = "B3:D5" 'rango a extraer
num = 1 'hoja origen, 1 significa que es la primera hoja
'
ruta = l1.Path & "\"
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Selecciona una carpeta"
.AllowMultiSelect = False
.InitialFileName = ruta
If .Show <> -1 Then Exit Sub
cp = .SelectedItems(1)
End With
'
arch = Dir(cp & "\" & "*.xls*")
Do While arch <> ""
Set l2 = Workbooks.Open(cp & "\" & arch)
Set h2 = l2.Sheets(num)
u = h1.Range(col & Rows.Count).End(xlUp).Row + 1
h2.Range(rango).Copy
h1.Cells(u, col).PasteSpecial xlValues
h1.Cells(u, col).PasteSpecial xlFormats
l2.Close False
arch = Dir()
Loop
MsgBox "Fin"
End SubAvísame si tienes dudas.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
