Excel VBA Retroactivos

Expertos buenos días,
Estoy
elaborando un proyecto para el calculo de retroactivos de mi empresa,
la solución que encontré no esta mal pero me gustaría adicionarle
algunas instrucciones donde algunas veces tengo problema. A continuación
el detalle y mi rutina actual:
A grandes rasgos tengo un
libro con 3 hojas: "DETALLESBI", "HISTOCONTR" y
"Configuración".
*DETALLESBI es mi reporte de ventas
*HISTOCONTR es el histórico de
cambios de precio pieza que vendemos.
*Configuración es una hoja donde en la columna A coloco los números de parte de las piezas que quiero calcular.
Como
la información es extensa debo identificar las piezas en el DETALLESBI y
en el HISTOCONTR y esto lo hago por medio de las siguientes formulas:
=SI(ESERROR(BUSCARV(C2,Configuración!A:A,1,0)=VERDADERO),"","Calcular Retroactivo")
=SI(ESERROR(BUSCARV(D2,Configuración!A:A,1,0)=VERDADERO),"","Calcular Retroactivo")
Una
vez que alimento la información de las 3 hojas mi rutina coloca un
filtro en las hojas DETALLESBI y HISTOCONTR para filtrar aquellas piezas
que contiene el texto "Calcular Retroactivo"; Una vez hecho esto la
información filtrada la paso a un segundo archivo llamado Calculo de
Retroactivo.xlsm que en realidad es el mismo que el original
(Retroactivo 2012.xlsm) solo que tiene adicionada una formula matricial
para lo que en breve les describirey lo guarda con el nombre Detalle de
Retroactivo.xlsm para no guardar los cambios.
La intención
es poder tener solo la información necesaria para buscar en la hoja
HISTOCONTR el precio que se tenia vigente al momento de la venta de una
pieza en determinada fecha según la hoja DETALLESBI, la formula para
calcular esto es la siguiente:
={SUMA((HISTOCONTR!$C$2:$C$1048576=DETALLE!B2)*(DETALLE!O2>=HISTOCONTR!$I$2:$I$1048576)*(DETALLE!O2<=HISTOCONTR!$J$2:$J$1048576)*(HISTOCONTR!$QUE$2:$QUE$1048576))}
Necesito de su ayuda para encontrar la rutina adecuada para optimizar mi proyecto y:
*Eliminar unicamente las filas de cada hoja que no contenga el texto "Calcular Retroactivo" (Columna A en ambas hojas)
*Calcular
por medio de VBA el reteroactivo con una solución similar u optimizada
de la que les presente de las piezas que resulte para calcular. A
continuación la ruitina que sinceramente con esfuerzo genere:
Sub CALCULO()
'
' CALCULO Macro
'
'
Application.ScreenUpdating = False
Sheets("DETALLESBI").Select
Cells.Select
Selection.AutoFilter
Sheets("HISTOCONTR").Select
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$1048576").AutoFilter Field:=1, Criteria1:="<>"
Sheets("DETALLESBI").Select
ActiveSheet.Range("$A$1:$P$1048576").AutoFilter Field:=1, Criteria1:="<>"
Workbooks.Open Filename:= _
"Z:\Usuarios\Finanzas\CUENTAS POR COBRAR\Herramienta Retroactivo\Calculo de Retroactivo.xlsm"
Windows("Retroactivo 2012.xlsm").Activate
Columns("B:P").Select
Selection.Copy
Windows("Calculo de Retroactivo.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Windows("Retroactivo 2012.xlsm").Activate
Sheets("HISTOCONTR").Select
Columns("B:L").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Calculo de Retroactivo.xlsm").Activate
Sheets("HISTOCONTR").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("DETALLESBI").Select
Columns("A:O").Select
Sheets("DETALLE").Select
Columns("A:O").Select
Range("O1").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
Sheets("DETALLESBI").Select
Selection.Copy
Sheets("DETALLE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Sheets("DETALLESBI").Select
Range("A1").Select
ActiveWorkbook.SaveAs Filename:= _
"Z:\Usuarios\Finanzas\CUENTAS POR COBRAR\Herramienta Retroactivo\Detalle de Retroactivo.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
Range("A1").Select
ThisWorkbook.Close savechanges:=False
End Sub
Toda mejora, replanteo o solución es bienvenida y muy agradecida. Gracias por su tiempo Expertos.
Edgar Ureña / [email protected]