Unir varios ficheros en uno vba Excel

V i s i t a:

Cursos de Excel y Macros

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 Sub

Recomendació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