Optimizar macro

[eneada]

Hola 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 que 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

 

[sergioMabres]

Hola Eneada
El loop de hojas esta bien hecho, hay que hacer el loop de filas, ya que lo que esta hecho solo lo hace 9 veces y se debe hacer con un for next
me imagino que es desde 10 hasta la ultima
Cuando tenga un rato te lo escribo
Saludos
Sergio

 

[sergioMabres]

Hola Eneada
Acá va la primera sub

Sub z_info_mes()
    Dim Fila, lr, i As Long, Hoja As Worksheet, h as String
    h = "AA_Datos"
    Sheets(h).Cells.ClearContents
    For Each Hoja In ThisWorkbook.Worksheets
        If Hoja.Name <> h Then
            lr = Hoja.Cells(Hoja.Rows.Count, 1).End(xlUp).Row
            For i = 18 To lr
                Fila = Fila + 1
                Sheets(h).Range("A" & Fila) = Hoja.Range("A2")
                Sheets(h).Range("B" & Fila) = Hoja.Range("C" & i)
                Sheets(h).Range("C" & Fila) = Hoja.Range("A" & i)
            Next i
        End If
    Next
End Sub

Si la copia se hace pesada tenes que deshabilitar el re calculo automático
Saludos
Sergio