Optimizar macro

eneada

New Member
Joined
Apr 24, 2017
Messages
2
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
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

sergioMabres

Well-known Member
Joined
Feb 24, 2013
Messages
946
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

Well-known Member
Joined
Feb 24, 2013
Messages
946
Hola Eneada
Acá va la primera sub
Code:
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
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,129,666
Messages
5,637,662
Members
416,979
Latest member
juliegeorge792

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top