Hello everyone,
Well, this "nothing optimized" macro has several goals and several problems.
I have a book with one sheet for each client, more than 150 sheets (and fortunately growing), of which I intend to extract certain data (total visits of each client). So I can analyze the information for months and try to improve the service to my clients. Well, at least, that's my theory
All the leaves have the same structure and my goal is:
- Extract the information from the "C18" column and the "A" cells of the same row (products) and the cell "A2" that will indicate the name the client's
And this information take it to the book "TtosMes.xlsx", "hoja1"
The problem is that I do not know what I did in any of the tests, which now only takes out the first 9 rows of information ... plus I have not achieved a loop that runs from the "C18" to the last cell with data , Of each sheet (starting with sheet 5); So my solution has been to manually create the route through the first 9 cells ("C18: C26") ... one by one ...
Another option I've tried is to extract all the complete "C" columns, from "C18" to the last with data and from sheet 5 onwards, but it has been even more complicated.
Does anyone guide me and can optimize this "prehistoric" macro? In the attached file are the separate macro (5 and 6) and attached (7)
This is the code:
Well, this "nothing optimized" macro has several goals and several problems.
I have a book with one sheet for each client, more than 150 sheets (and fortunately growing), of which I intend to extract certain data (total visits of each client). So I can analyze the information for months and try to improve the service to my clients. Well, at least, that's my theory
All the leaves have the same structure and my goal is:
- Extract the information from the "C18" column and the "A" cells of the same row (products) and the cell "A2" that will indicate the name the client's
And this information take it to the book "TtosMes.xlsx", "hoja1"
The problem is that I do not know what I did in any of the tests, which now only takes out the first 9 rows of information ... plus I have not achieved a loop that runs from the "C18" to the last cell with data , Of each sheet (starting with sheet 5); So my solution has been to manually create the route through the first 9 cells ("C18: C26") ... one by one ...
Another option I've tried is to extract all the complete "C" columns, from "C18" to the last with data and from sheet 5 onwards, but it has been even more complicated.
Does anyone guide me and can optimize this "prehistoric" macro? In the attached file are the separate macro (5 and 6) and attached (7)
This is the code:
Code:
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
Last edited by a moderator: