En un libro crea 2 hojas y les pones por nombre "Valores" y "Resumen"
En la hoja "Valores" pon la siguiente información:
Asigna la macro al botón:
Sub Importar_Datos()
'
' Por.Dante Amor
'
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Valores")
Set h2 = l1.Sheets("Resumen")
h2.Cells.ClearContents
'
ruta = h1.[B5] 'carpeta
hoja = h1.[B6] 'hoja
fila = h1.[B7] 'fila de datos
colu = h1.[B8] 'columna principal
'
mensaje = validaciones(ruta, hoja, fila, colu)
If mensaje <> "" Then
MsgBox mensaje, vbExclamation, "IMPORTAR ARCHIVOS"
Exit Sub
End If
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = False
Application.Calculation = xlCalculationManual
'
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
arch = Dir(ruta & "*.xls*")
i = 0
Do While arch <> ""
i = i + 1
Application.StatusBar = "Importando Libro : " & i & " de : " & n
Set l2 = Workbooks.Open(ruta & arch)
existe = False
If hoja <> "*" Then
If IsNumeric(hoja) Then
If l2.Sheets.Count >= hoja Then
existe = True
Set h22 = l2.Sheets(hoja)
Else
End If
Else
For Each h In l2.Sheets
If LCase(h.Name) = LCase(hoja) Then
existe = True
Set h22 = l2.Sheets(hoja)
Exit For
End If
Next
End If
If existe Then
u22 = h22.Range(colu & Rows.Count).End(xlUp).Row
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h22.Rows(fila & ":" & u22).Copy
h2.Range("A" & u2).PasteSpecial xlValues
End If
Else
For Each h In l2.Sheets
Set h22 = h
u22 = h22.Range(colu & Rows.Count).End(xlUp).Row
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h22.Rows(fila & ":" & u22).Copy
h2.Range("A" & u2).PasteSpecial xlValues
Next
End If
'
'
l2.Close False
arch = Dir()
Loop
'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
'
MsgBox "Proceso terminado, archivos importados a la hoja resumen", vbInformation, "IMPORTAR ARCHIVOS"
End Sub
'
Function validaciones(ruta, hoja, fila, colu)
validaciones = ""
If ruta = "" Then
validaciones = "Escribe la Carpeta donde están los archivos"
Exit Function
End If
If Dir(ruta, vbDirectory) = "" Then
validaciones = "No existe la Carpeta"
Exit Function
End If
If hoja = "" Then
validaciones = "Escribe el nombre o número de hoja"
Exit Function
End If
If fila = "" Or Not IsNumeric(fila) Or fila < 1 Then
validaciones = "Escribe la fila inicial"
Exit Function
End If
If colu = "" Or IsNumeric(colu) Then
validaciones = "Escribe la columna principal"
Exit Function
End If
'
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
arch = Dir(ruta & "*.xls*")
n = 0
Do While arch <> ""
n = n + 1
arch = Dir()
Loop
If n = 0 Then
validaciones = "No hay archivos de excel a importar en la carpeta : " & ruta
Exit Function
End If
End Function
Sigue las Instrucciones para un botón y ejecutar la macro
- Abre tu libro de Excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- En el menú elige Insertar / Módulo
- En el panel del lado derecho copia la macro
- Ahora para crear un botón, puedes hacer lo siguiente:
- Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
- Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
- Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
- Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: Importar_Datos
- Aceptar.
- Para ejecutarla dale click a la imagen.
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.