Unir varios ficheros en uno vba Excel
Tengo varios ficheros Excel en una carpeta que se llaman igual y quiero copiar las filas de cada uno para pegarlas en un solo fichero.
V i s i t a:
Comparte los enlaces con alguien que desee conocer sobre Excel y Macros.
Sería ideal que pusieras toda la información que tienes:
- Cómo se llama la carpeta
- Desde cuál fila se va a copiar
- Cuáles columnas
- etc. etc.
Prueba la siguiente macro, te permite seleccionar una carpeta donde están tus archivos, copia todas las filas con datos de la primer hoja de cada archivo y la pega en la primer hoja de archivo donde pongas la macro.
Sub Unir_Archivos()
'---
' Por.Dante Amor
'---
'
'VARIABLES
Dim l1 As Workbook, l2 As Workbook
Dim h1 As Worksheet, h2 As Worksheet
Dim nom As String, ruta As String, dato As String
Dim fila As Long, u2 As Long, u1 As Long
Dim arch As Variant
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
'ENTRADAS
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(1)
h1.Range("A2:I" & h1.Rows.Count).Clear
nom = l1.Name
'
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Selecciona la carpeta con los archivos"
If .Show <> -1 Then Exit Sub
ruta = .SelectedItems(1) & "\"
End With
fila = 1
arch = Dir(ruta & "*.xls*")
'
'PROCESO
Do While arch <> ""
dato = Left(arch, InStrRev(arch, ".") - 1)
If arch <> nom Then
Set l2 = Workbooks.Open(ruta & arch)
Set h2 = l2.Sheets(1)
u2 = h2.Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious).Row
h2.Rows("1:" & u2).Copy h1.Range("A" & fila)
u1 = h1.Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious).Row
fila = u1 + 1
l2.Close False
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Archivos unidos", vbInformation
End SubRecomendación del día:
Consejos para desarrollar macros - YouTube
Sal u dos
Gracias Dante, sería copiar todo el contenido en un libro nuevo no exigente y una todos los ficheros que contengan la misma palabra por ejemplo prueba, prueba1, muchas gracias por tu ayuda
"
Tengo varios ficheros Excel en una carpeta que se llaman igual y quiero copiar las filas de cada uno para pegarlas en un solo fichero.
"
Con solamente ese texto es imposible definir todo lo que necesitas.
Envía con todo detalle lo que necesitas.
