Combinar varias macros

1 post / 0 nuevos
hector
Imagen de hector
Offline
última acción: Hace 5 años 5 meses
alta: 10/05/2015 - 16:24
Puntos: 25
Combinar varias macros

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.