Resumen de datos, salir de un bucle

[LuisV26]

Saludos, Amigos del foro, Estoy haciendo una macro que me saque un resumen en este caso de las ventas de un mes, con lo que he aprendido y con la ayuda de la grabadora de macros logre sacar un codigo que ordena los datos de la hoja Cons.Ventas Por Proveedor luego insetar subtotales de ahi delvuelve a la hoja Resumen los datos de estos subtotales con las caracteristicas que nesesito. Hasta ahi bien. El problema que tengo es que el bucle que deberia dar fin a la ejecucion de la macro no funciona y la macro se sigue ejecutando devolviendo al final de la hoja Resumen datos que no corresponden.

Dejo un archivo con un ejemplo. Si alguien puede darme una mano o ideas de funciones que realizen esta misma tarea con un codigo mas agil les estare muy gradecido.

Saludos.

LuisV.

Ejemplo Hoja Resumen IG.rar

[Armando Montes]

Se puede simplificar, si muestras en el ejemplo, manualmente, los resultados para 4-5 proveedores, te muestro como.

[LuisV26]

Ssludos.

Con el boton que esta en la hoja Cons. Vtas por proveedor se ejecura la macro. lo que hace en si es tomar los datos, primero organizarlos por la columna D "PROVEEDOR" luego los organiza por la columna A "SUCURSAL" se seleccionan los datos y se insertan subtotales para cada cambio en la columna D subtotal en la columna E Y G "CANTIDAD Y COSTO PROMEDIO TOTAL"

Para recorrer la columna D use un la funcion 'buscar' en cada celda la palabra total bueno, la encuentra y me lleva el valor total y la cantidad consolidad de las ventas por sucursal y proveedor a la hoja Resumen.

El Problema es que el bucle que deberia marcar el final de la macro no funciona por que estoy utilizando la funcion 'buscar'.

Se que el codigo es muy largo si se pudiera acortar un poco con otras funciones agradeceria la informacion... jeje

Agradezco el interes.

chao.

[Armando Montes]

Para acortarlo es que te pedi incluir en el ejemplo algunos resultados, insertados manualmente.

Segun las normas del foro debes usar etiquetas en los codigos publicados.

[LuisV26]

Saludos Gracias por el interes en este tema,

Lo que nesesito que haga la macro es consolidar los datos de cada sucursal por proveedor cantidad y costo promedio total

el codigo que dejo abajo realiza la tarea probe paso por paso con F8 y me di cuenta que no funciona la parte del bucle que deberia marcar el final de la macro no funciona por que estoy utilizando la funcion buscar.

como o que bucle puedo utilizar para terminar la macro en la ultima celda de la columna D que contenga la palabra "Total"

Codigo:
Option Explicit

Sub ResumenInventario()

'Application.ScreenUpdating = False
Application.CutCopyMode = False

Worksheets("Cons. Vtas por proveedor").Activate

    ActiveWorkbook.Worksheets("Cons. Vtas por proveedor").Sort.SortFields.Add Key _
        :=Range("D1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Cons. Vtas por proveedor").Sort.SortFields.Add Key _
        :=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

Range("a1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(5, 7), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Range("D10000").End(xlUp).Offset(1, 0).Value = "1"

Worksheets("Resumen").Activate
Range("B3").Select
Worksheets("Cons. Vtas por proveedor").Activate
Range("d1").Select

Do While ActiveCell.Value <> "1"

Application.CutCopyMode = False
Cells.Find(What:="Total", After:=ActiveCell, SearchOrder:=xlByColumns).Activate

ActiveCell.Offset(-1, -3).Select
Selection.Copy
Worksheets("Resumen").Activate
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select

Worksheets("Cons. Vtas por proveedor").Activate
ActiveCell.Offset(0, 3).Select
Selection.Copy
Worksheets("Resumen").Activate
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select

Worksheets("Cons. Vtas por proveedor").Activate
ActiveCell.Offset(0, 8).Select
Selection.Copy
Worksheets("Resumen").Activate
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select

Worksheets("Cons. Vtas por proveedor").Activate
ActiveCell.Offset(0, 1).Select
Selection.Copy
Worksheets("Resumen").Activate
ActiveSheet.Paste

Worksheets("Cons. Vtas por proveedor").Activate
ActiveCell.Offset(1, -6).Select
Selection.Copy
Worksheets("Resumen").Activate
ActiveCell.Offset(0, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(0, -1).Select

Worksheets("Cons. Vtas por proveedor").Activate
ActiveCell.Offset(0, -2).Select
Selection.Copy
ActiveCell.Offset(0, -1).Select
Worksheets("Resumen").Activate
Selection.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(1, -6).Select

Worksheets("Cons. Vtas por proveedor").Activate
Loop

End Sub
[/PHP]

Saludos

LuisV

[Armando Montes]

Gracias Luis, solo viendo en el ejemplo algunos resultados esperados podre sugerir alguna opcion.

De momento la unica sugerencia es eliminar los activate, select.

[LuisV26]

Saludos,

Si ejecutas la macro que deje de ejemplo podras ver el resultado que nesesito.

Como dije anteriormente el problema lo tengo es en el Bucle que se queda trabado por la funcion buscar que utilizo para ubicar los datos, Esto lose porque ejecute la macro desde VBA Con F8.

Saludos.

Gracias Por el interes.