none
IMPORTAR Y UNIR VARIAS HOJAS DE VARIOS LIBROS EN UNO SOLO RRS feed

  • Pregunta

  • Hola, estoy intentando hacer una macro de Excel que unifique en un libro Excel .xlsx las distintas hojas correspondientes a un número indeterminado de libros que los tengo en una misma carpeta.

    He conseguido hacerlo para una sola hoja con determinado nombre de hoja, pero no sé cómo hacerlo para que me copie los datos de las distintas hojas en el mismo orden y de forma unificada por nombre de hoja.

    Es decir, que si hay 20 libros y cada uno de estos tiene el mismo número y nombre de hojas, me los guarde en un libro nuevo con el mismo número y nombre de hojas con los datos consolidados.

    Os pongo el código que he creado para copiar una hoja en concreto de varios libros. Un saludo.

    Sub Unir_Ficheros()

        Dim usuario As String
        usuario = Application.UserName
        Select Case usuario
                Case "pepe": usuario = "José"
              Case "manolo": usuario = "Manuel"
               Case "kiko": usuario = "Enrique"
        End Select
        Hora = (Now - Int(Now)) * 24
        Select Case Hora
        Case 6 To 13, 30, 0
        horario = "BUENOS DIAS"
        Case 13, 30, 1 To 20
        horario = "BUENAS TARDES"
        Case Else
        horario = "BUENAS NOCHES"
        End Select
       
        Dim respuesta1 As String
        respuesta1 = MsgBox(horario & " " & usuario & ", A CONTINUACION SE VA A CREAR UN NUEVO FICHERO CON EL NOMBRE 'TODAS LAS UPS', NO MODIFIQUES ESTE NOMBRE (puedes modificar el nombre del libro una vez haya concluido la macro).                                                                                                                                                                                                                                    PARA QUE FUNCIONE CORRECTAMENTE, DEBES GUARDAR ESTE FICHERO EN LA MISMA CARPETA DONDE TIENES TODOS LOS LISTADOS A UNIFICAR.", vbInformation + vbOKCancel, "AVISO MUY IMPORTANTE")
        If respuesta1 = vbCancel Then Exit Sub
        If respuesta1 = vbOK Then

        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
       
    'CREO LIBRO NUEVO PARA EL ANEXO
        Dim NuevoLibro As String
        Workbooks.Add
       
        NuevoLibro = Application.GetSaveAsFilename("TODAS LAS UPS", "Libro de Excel,*.xlsx")
        ActiveWorkbook.SaveAs FileName:=NuevoLibro, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    'identifico nombre del libro
        Dim NombreActual As String
        NombreActual = ActiveWorkbook.Name

        Workbooks(NombreActual).Activate 'libro nuevo TODAS LAS UPS

    ruta = ThisWorkbook.Path
    ChDir ruta

    'DAR OPCION A CAMBIAR EL NOMBRE LA HOJA AL USUARIO++++++++++++++++++++++++++++++++++++++++++
    Range("AX1").Select

    Dim respuesta2 As String
    respuesta2 = InputBox("Se van a importar todas las hojas con el nombre 'AnalisisPrevio' de todos los libros contenidos en la carpeta que estás trabajando.                                                                                                                             Si quieres importar otra Hoja con nombre distinto, modifícalo a continuación.", "CONFIRMACION DEL NOMBRE DE LA HOJA A IMPORTAR", "AnalisisPrevio")

    ActiveCell.FormulaR1C1 = respuesta2

    Hoja = ActiveCell.Value
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    archi = Dir("*.xlsx")
    Set Actual = Workbooks(NombreActual)

    On Error Resume Next
    Do While archi <> ""
        Workbooks.Open archi   '

        Sheets(Hoja).Cells.Copy   '
       
        If Err.Number = 0 Then
            Actual.Activate   '
            Worksheets.Add
            ActiveSheet.Paste
            ActiveWorkbook.Save
        Else
            Err.Number = 0
        End If
       
        Workbooks(archi).Close
        archi = Dir()
    Loop

    'vuelvo abrir el libro Workbooks.Open(Actual)TODAS LAS UPS.xlsx

        Workbooks.Open FileName:=(strRuta & "TODAS LAS UPS.xlsx")
        Sheets("Hoja1").Select
        Range("AX1").Select
        Selection.ClearContents
       
            Dim Hojas As Object
           
                For Each Hojas In ActiveWorkbook.Sheets
                Hojas.Copy after:=Actual.Sheets(Actual.Sheets.Count)
                Next
                Actual.Close False
                 
           'Unir_Hojas
            Dim Siguiente As Byte, Eliminar As Boolean
                For Siguiente = 2 To Worksheets.Count
                Worksheets(Siguiente).UsedRange.Copy _
                Worksheets(1).Range("A1000000").End(xlUp).Offset(1)
                Next
               
        For Siguiente = 2 To Worksheets.Count
            Worksheets(2).Delete
        Next

    'elimino los duplicados de las filas de titulos+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Windows("TODAS LAS UPS.xlsx").Activate
            Sheets("Hoja2").Select
            If Range("A1").Value = Empty Or Range("A2").Value = Empty Then
            Dim Informacion As Variant
            Informacion = MsgBox("No hay Hojas con el nombre '" & respuesta2 & "' a importar o unificar.", vbInformation + vbOKOnly, "Información")
            Windows("TODAS LAS UPS.xlsx").Activate
            Windows("TODAS LAS UPS.xlsx").Close
           
            Exit Sub
            Else

    Range("A1").Select
    Selection.AutoFilter

        Range("BX1").Select
        ActiveCell.FormulaR1C1 = "=RC[-75]"
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        UltimaFila = Range("A1000000").End(xlUp).Row
        ActiveSheet.Range("$A$1:$BT$" & UltimaFila).AutoFilter Field:=1, Criteria1:=ActiveCell.Value, Operator:=xlAnd
    'selecciono solo las filas visibles tras filtro
        Dim sel As Range
        Set sel = Range("A1").CurrentRegion
        Set sel = Range(sel(2, 1), sel(sel.Rows.Count, sel.Columns.Count))
        sel.Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.Range("$A$1:$BT$" & UltimaFila).AutoFilter Field:=1

        Range("BX1").Select
        Selection.ClearContents
        Range("A1").Select
      
        ActiveSheet.Name = "DatosImportados"
    End If
      End If
     
    End Sub

    martes, 14 de abril de 2020 7:27

Todas las respuestas

  • Hola Rafael

    No se si a estas alturas aún te sirva pero aquí te doy una solución:

    En tu código veo que llevas un buen avance, aunque no me queda muy claro del todo.

    Lo que te entiendo es que como "no sabes" los nombre ni el orden de las hojas no hay manera de copiarlas.

    Con el primer archivo primero debes utilizar el "For each Hojas..." y capturar el nombre de cada una de las hojas (propiedad Worksheet.Name) en un vector tipo string.

    De ese modo en los siguientes libros, en vez de usar un "For each Hojas..." usas un For normal recorriendo el vector que creaste. La selección de la hoja se hace del siguiente modo: ActiveWorkbook.Sheets(vector(i)) 

    Espero te ayude, quedo atento a tus dudas.

    Saludos.

    lunes, 22 de junio de 2020 17:52