Estimados:
Encontre una macro en yuotube, la macro abre varios libros excel y copia información de determinadas hojas (rangos), centrando la información a un formulario (hoja excel). La macro es la siguiente:
Sub CONSOLIDAR_FICHAS()
Dim ARCHIVOS As Variant
Dim ARCHIVOMAESTRO As Workbook
Dim ARCHIVOACTUAL As Workbook
Dim N As Integer
Dim ULTIMAFILA As String
Application.DisplayAlerts = False
Set ARCHIVOMAESTRO = ActiveWorkbook
ARCHIVOS = Application.GetOpenFilename(FILEFILTER:="EXCEL fiLES,*.XLSX", MultiSelect:=True)
If IsArray(ARCHIVOS) Then
Application.ScreenUpdating = False
For N = LBound(ARCHIVOS) To UBound(ARCHIVOS)
Workbooks.Open Filename:=ARCHIVOS(N)
Sheets("PGMFp.GENERALES").Select
Range("C2:X2").Select
Selection.Copy
Set ARCHIVOACTUAL = ActiveWorkbook
ARCHIVOMAESTRO.Activate
Sheets("PGMFp.GENERALES").Select
Range("A3000").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'ActiveSheet.Paste
ARCHIVOACTUAL.Close SAVECHANGES:=False
Next
Else
Exit Sub
End If
End Sub
En cada libro Excel (de donde copia la información) contienen como 4 hojas excel. Para centrar la información tengo que ejecutar cuatro macros similares, donde, solo difieren en el titulo de la hoja excel y rango. La otra macro es la siguiente:
Sub CONSOLIDAR_ESPECIES()
Dim ARCHIVOS As Variant
Dim ARCHIVOMAESTRO As Workbook
Dim ARCHIVOACTUAL As Workbook
Dim N As Integer
Dim ULTIMAFILA As String
Application.DisplayAlerts = False
Set ARCHIVOMAESTRO = ActiveWorkbook
ARCHIVOS = Application.GetOpenFilename(FILEFILTER:="EXCEL fiLES,*.XLSX", MultiSelect:=True)
If IsArray(ARCHIVOS) Then
Application.ScreenUpdating = False
For N = LBound(ARCHIVOS) To UBound(ARCHIVOS)
Workbooks.Open Filename:=ARCHIVOS(N)
Sheets("PGMFp.ESPECIES").Select
Range("A2:G65").Select
Selection.Copy
Set ARCHIVOACTUAL = ActiveWorkbook
ARCHIVOMAESTRO.Activate
Sheets("PGMFp.ESPECIES").Select
Range("A3000").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'ActiveSheet.Paste
ARCHIVOACTUAL.Close SAVECHANGES:=False
Next
Else
Exit Sub
End If
End Sub
Como observaran son similires, los achivos de donde se copia la información son las mismas. Lo que necesito es combinar las dos macros en uno, donde solo una vez selecciones los archivos (libros excel) y de ellos se copie la información a cada hoja que corresponde.
