¿Como Optimizar Macro excel 2010 para extraer datos?
A tod@s,
Bueno pues esta "nada optimizada" macro tiene varios objetivos y varios problemas.
Tengo un libro con una hoja por cada cliente, más de 150 hojas (y afortunadamente creciendo), del cual pretendo extraer ciertos datos (visitas totales de cada cliente). Así podré analizar la información por meses y tratar de mejorar el servicio a mis clientes. Bueno, al menos, esa es mi teoria :)
Todas las hojas tienen la misma estructura y mi objetivo es:
- Extraer la información de la comlumna "C18" en adelante (donde están las fechas de cada visita del cliente) junto con las celdas "A" de la misma fila (productos) y la celda "A2" que me va a indicar el nombre del cliente
Y esta información llevarla al libro "TtosMes.xlsx", "hoja1"
El problema es que, no se que hice en alguna de las pruebas, que ahora solo me saca las 9 primeras filas de la información ... Además que no he logrado un bucle que recorra desde la "C18" hasta la última celda con datos, de cada hoja (empezando por la hoja 5); asi que mi solución ha sido crear, manualmente, el recorrido por las 9 primeras celdas ("C18:C26")... Una a una ...
Otra opción que he intentado es extraer todas las columnas "C" completas, desde la "C18" hasta la última con datos y desde la hoja 5 en adelante, pero me ha resultado aún más complicado.
¿Alguien qué me oriente y pueda optimizar este "prehistórica" macro? En el archvo adjunto estan las macro por separado (5 y6 ) y unidas (7)
Este es el código:
Sub z_info_mes()
Dim Fila As Long, Hoja As Worksheet
Sheets("AA_Datos").Cells.ClearContents
For Each Hoja In ThisWorkbook.Worksheets
If Hoja.Name <> ActiveSheet.Name Then
Fila = Fila + 1
Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C18")
Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A18")
Fila = Fila + 1
Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C19")
Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A19")
Fila = Fila + 1
Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C20")
Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A20")
Fila = Fila + 1
Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C21")
Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A21")
Fila = Fila + 1
Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C22")
Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A22")
Fila = Fila + 1
Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C23")
Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A23")
Fila = Fila + 1
Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C24")
Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A24")
Fila = Fila + 1
Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C25")
Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A25")
Fila = Fila + 1
Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C26")
Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A26")
End If
Next
End Sub
Sub zz_Libro_ttosmes()
'Definir objetos a utilizar
Dim wbDestino As Workbook, _
wsOrigen As Excel.Worksheet, _
wsDestino As Excel.Worksheet, _
rngOrigen As Excel.Range, _
rngDestino As Excel.Range
'Indicar el libro de Excel destino
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "\TtosMes.xlsx")
'Activar este libro
ThisWorkbook.Activate
'Indicar las hojas de origen y destino
Set wsOrigen = Worksheets("AA_Datos")
Set wsDestino = wbDestino.Worksheets("Hoja1")
'Indicar la celda de origen y destino
Const celdaOrigen = "A1"
Const celdaDestino = "A1"
'Inicializar los rangos de origen y destino
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
'Seleccionar rango de celdas origen
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Pegar datos en celda destino
rngDestino.PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Guardar y cerrar el libro de Excel destino
WbDestino. Save
WbDestino. Close
End Sub
1 respuesta
Te anexo la macro para copiar los datos.
Pon la macro en un módulo en el libro donde tienes todas las hojas de tus clientes.
Antes de ejecutar la macro debes abrir tu archivo "TtosMes.xlsx"
La macro copia información de la hoja 5 en adelante.
La macro copia la columna C (fechas) y la pega en la C
Copia la columna A (productos) y la pega en la coluna B
El cliente (A2) y lo pega en la columna A
Sub Copiar_Info_Clientes()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook 'libro con la macro y con las hojas de clientes
Set l2 = Workbooks("TtosMes.xlsx") 'libro destino, debe estar abierto
Set h2 = l2.Sheets("Hoja1") 'hoja destino
h2.Rows("2:" & Rows.Count).ClearContents 'limpia la hoja destino de la fila 2 en adelante
'
For i = 5 To l1.Sheets.Count
Set h1 = l1.Sheets(i)
u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
u2 = h2.Range("C" & Rows.Count).End(xlUp).Row + 1
If u1 < 18 Then u1 = 18
h1.Range("A18:A" & u1).Copy h2.Range("B" & u2)
h1.Range("C18:C" & u1).Copy h2.Range("C" & u2)
h2.Range("A" & u2 & ":A" & h2.Range("C" & Rows.Count).End(xlUp).Row) = h1.Range("A2")
Next
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
¡Gracias! Dante Amor
Excelente, pero me he visto en la "obligación moral" de añadir alugunas líneas de código más:
'no puede ser que el código de Dante sea tan corto y el mio tan malo
'no puede ser que el código de Dante sea tan corto y el mio tan malo
'no puede ser que el código de Dante sea tan corto y el mio tan malo
'no puede ser que el código de Dante sea tan corto y el mio tan malo
'no puede ser que el código de Dante sea tan corto y el mio tan malo
:) :):)
