Copiar la información de varios libros de Excel a un solo libro.
Tengo una macro que me ayuda a copiar la información de varios libros de Excel en uno, esta macro abre una ventana de explorador que me permite seleccionar y concentrar toda la información en un solo libro. Hasta el momento la macro lo hace, sin embargo, quiero modificarla para que toda la información la concentre en una pestaña especifica llamada "Base" de un Templete que se llama "ManHoursGeneral", que a su vez, tiene mas pestañas y lo haga sin borrar o alterar las demás pestañas.
Al momento de pegar la información en el libro ManHoursGeneral, lo hace en una "Sheet1" nueva.
El patrón de los archivos es el mismo, comprenden desde Columna A hasta AD, en la fila 1, de cada archivo vienen los encabezados y a partir de la fila 2, comienza la información. Me gustaría que la información de todos los archivos la pegara en la pestaña " Base ", a partir de la columna A - fila 2, para dejarle un encabezado al Templete.
La Macro que tengo es:
Sub open_books()
Dim Hoja As Object
Application.ScreenUpdating = False
'Definir la variable como tipo Variante
Dim X As Variant
'Abrir cuadro de dialogo
X = Application.GetOpenFilename _
("Excel Files (*.xlsx), *.xlsx", 2, "Abrir archivos", , True)
'Validar si se seleccionaron archivos
If IsArray(X) Then ' Si se seleccionan
A = ActiveWorkbook.Name
'*/********************
For y = LBound(X) To UBound(X)
Application.StatusBar = "Importando Archivos: " & X(y)
Workbooks.Open X(y)
b = ActiveWorkbook.Name
For Each Hoja In ActiveWorkbook.Sheets
Hoja.Copy after:=Workbooks(A).Sheets(Workbooks(A).Sheets.Count)
Next
Workbooks(b).Close False
Next
Application.StatusBar = "Listo"
Call Unir_Hojas
End If
Application.ScreenUpdating = False
End Sub
Sub Unir_Hojas()
Dim Sig As Byte, Eliminar As Boolean
For Sig = 2 To Worksheets.Count
u = Worksheets(Sig).UsedRange.Rows(Worksheets(Sig).UsedRange.Rows.Count).Row
u2 = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
If u2 < 3 Then u2 = 3
Worksheets(Sig).Rows("2:" & u).Copy _
Worksheets(1).Range("A" & u2)
Next
Application.DisplayAlerts = False
For Sig = 2 To Worksheets.Count
Next
Application.DisplayAlerts = True
End Sub
