Código VBA para abrir cuadro de dialogo y seleccionar archivo origen y copiar datos
Para @dante amor
Mi escenario es el siguiente: Tengo un libro llamado "work" que contiene seis hojas (mes1, mes2, mes3, mes4, mes5 y mes6) y necesito copiar, de un archivo que no siempre tiene el mismo nombre, pero si el mismo numero y nombre de hojas, los datos en ese mismo orden que aparecen. Es decir, abrir un cuadro de dialogo para seleccionar "libroX" y copiar desde "libroX" mes1 a "work" mes1 en la ultima fila activa y así, respectivamente con las demás hojas.
H o l a:
Envíame 3 archivos, de la siguiente forma:
El archivo1 será tu libro "work", con la información antes del pegado.
El archivo2 será el "librox", en este libro me marcas de color amarillo las filas que quieres copiar.
El archivo3 sera el libro "work3", deberá tener la información del libro "work" más la información que marcaste en amarillo en el "librox"
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “adrian valiñas” y el título de esta pregunta.
Te anexo la macro
Sub Copiar_Datos()
'---
' Por.Dante Amor
'---
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
'
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Add "Archivos de Excel", "*.xls*"
.AllowMultiSelect = False
.InitialFileName = l1.Path & "\"
If Not .Show Then Exit Sub
archivo = .SelectedItems.Item(1)
End With
Set l2 = Workbooks.Open(archivo)
'
For Each h2 In l2.Sheets
existe = False
For Each h1 In l1.Sheets
If LCase(h2.Name) = LCase(h1.Name) Then
existe = True
Set h11 = h1
Set h22 = h2
Exit For
End If
Next
If existe Then
u1 = h11.Range("A" & Rows.Count).End(xlUp).Row + 1
u2 = h22.Range("A" & Rows.Count).End(xlUp).Row
h2.Rows(4 & ":" & u2).Copy h1.Range("A" & u1)
End If
Next
l2.Close False
Application.ScreenUpdating = True
MsgBox "Proceso terminado"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
