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 Respuesta
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
