Macro que recorra columna y busque libro según nombre de celda y copie las hojas al libro activo

Referente a la macro que quiero realizar necesito que me ayuden a seguir, aunque solo sea recorrer columna y inportar las hojas de los libros que se encuentren en la columna. Tengo la siguiente macro que encontré en la web y la he modificado según necesitaba;

Sub Open_Files()

Dim directorio As String
Dim fichero As String
Dim ficherodondeimportar As String
Dim hoja As Worksheet
Dim totalhojas As Integer
Application.ScreenUpdating = False
'Definir la variable como tipo Variante
Dim X As Variant
'Abrir cuadro de dialogo
ChDir "C:\Users\David\Desktop\Libros para Importar"
X = Application.GetOpenFilename _
("Excel Files (*.xls*), *.xls*", 2, "Abrir archivos", , True)
If IsArray(X) Then ' Si se seleccionan
'directorio = "C:\Users\David\Desktop\Libros para Importar"
ficherodondeimportar = "Unificar_libros_Excel.xlsm"
fichero = Dir(directorio & "*.xls*")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Do While fichero <> ""

Workbooks.Open (directorio & fichero)
For Each hoja In Workbooks(fichero).Worksheets
totalhojas = Workbooks(ficherodondeimportar).Worksheets.Count
Workbooks(fichero). Worksheets(hoja. Name).Copy after:=Workbooks(ficherodondeimportar). Worksheets(totalhojas)
Next hoja
Workbooks(fichero).Close
fichero = Dir()
Application.DisplayAlerts = False

Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = True
End Sub

Y lo hace es importa a un libro todas las hojas de cada libro en uno, pero me gustaría realizar una macro mediante un userform con nombre User_importar, y lo que tengo es un combobox llamado comb_dir, que me arroja un listado de nombres que según escoja me trae la dirección de una carpeta en un textbox llamado text_Carpeta donde con un comanbutton llamado Aceptar se supone que mediante la macro que pido es que en el libro donde se encuentra el userform con nombre DESINGDVACH222 recorra la columna "B" a partir de la fila 7 de la hoja con nombre PRESUPUESTO FINAL y según va recorriendo hacia abajo, cuando encuentre una referencia pongo un ejemplo DFS100045 que busque en el textbox con nombre text_Carpeta la dirección recorra la carpeta buscando el libro con nombre de la referencia lo abra y exportar las hojas existentes al libro con nombre DESINGDVACH222 y si existe dicha hoja en el libro que la reemplaze y siga recorriendo la columna y si encuentra una palabra o referencia que no se encuentra en la carpeta que siga y así que haga un bucle.

1

1 Respuesta

3.688.050 pts. Si me amas, siempre voy a estar en tu corazón; si me...

Envíame lo siguiente:

2 libros con datos que quieres importar, en cada libro me marcas de amarillo lo que quieres importar

1 libro con el userform, me explicas con un ejemplo qué quieres poner el formulario; y en una hoja, me pones el resultado esperado, en teoría debes poner la información que coloreaste en amarillo en los otros 2 libros.

No te preocupes por la macro, de eso me encargo yo, solamente trata de ser lo más claro posible explicando el ejemplo.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “David Calleja

Te anexo la macro

Sub Copiar_Hojas()
'Por.Dante Amor
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    Set l1 = ThisWorkbook
    Set h = l1.ActiveSheet
    '
    ruta = "\\MOZART\Presupuestos\Dvach_2017\Pres_en Group\"
    ruta = l1.Path
    '
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Selecciona una carpeta"
        .AllowMultiSelect = False
        .InitialFileName = ruta
        If .Show <> -1 Then Exit Sub
        cp = .SelectedItems(1) & "\"
    End With
    '
    arch = Dir(cp & "*xls*")
    Do While arch <> ""
        d = InStrRev(arch, ".") - 1
        nom = Left(arch, d)
        '
        Set b = h.Columns("A").Find(nom, lookat:=xlWhole)
        If Not b Is Nothing Then
            Set l2 = Workbooks.Open(cp & arch)
            For Each h2 In l2.Sheets
                For Each h1 In l1.Sheets
                    If h2.Name = h1.Name Then
                        h1.Delete
                        Exit For
                    End If
                Next
            Next
            '
            l2.Sheets.Copy after:=l1.Sheets(l1.Sheets.Count - 1)
            l2.Close False
        End If
        arch = Dir()
    Loop
    h.Select
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Buenas noches una vez más, quiero agradecer todo el trabajo que conlleva está macro y me funciona satisfactoriamente desde la hoja mediante el botton, pero al hacer la llamada a la macro desde la cinta de Ribbon, me da error 91 Variable de objeto o bloque with no establecido y se para en esta linea.

Set b = h.Columns("A").Find(nom, lookat:=xlWhole)

Siento molestarle pero se me olvido comentarle que trabajo desde la cinta de Ribbon perdón.

Envíame tu archivo para revisarlo en tu archivo, me dices exactamente en dónde está la macro en el ribbon.

Mi correo [email protected] en el asunto pon tu nombre de usuario

En estas líneas establece como l1 al libro que tiene la macro. Si ejecutas la macro desde otro libro, entonces ese "otro libro" quedará establecido en el objeto l1

    'Set l1 = ThisWorkbook
    'Set h = l1. ActiveSheet

Si la macro está en otro libro, y quieres que se ejecute sobre un tercer libro, entonces tienes que establecer cuál libro.

Por ejemplo, libro con la macro "Comp_dvach_1.xlam"

Libro destino "DESING DVACHQ222 B dam2.xlsm"

Entonces el código quedará así:

    Set l1 = Workbooks("DESING DVACHQ222 B dam2.xlsm")
    Set h = l1.Sheets(1)

Tienes que indicar el nombre del libro destino y además deberá estar abierto.

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas