Macro en Excel

[08Alf]

Hola
Tengo una macro en Excel que hace lo siguiente:

1º-Abro el fichero
2º-Habilito la Macro
3º-Se ejecuta
4º-Pulsando Alt+F11 accedo al código, hago las modificaciones necesarias en el código, grabo y cierro el fichero de excel
5º-Vuelvo a abrir el fichero, habilito la macro y me da un error (El error en realidad no es tal pero el caso es que no funciona)

Lo curioso del tema es que si hago lo siguiente:
5º-Abro el fichero, deshabilito la macro, pulso Alt+F11, accedo al código y situado en cualquier parte del mismo, grabo y cierro el fichero.
6º-Abro el fichero, habilito la macro y Eureka !! no me da el error.

¿Alguien sabe lo que está pasando?

[opermty]

No pues ni idea que pretendes con la macro, no imagino que realizes con ella ... puedes exponer el codigo ..

[08Alf]

Gracias, pero no sé si tendrá que ver con el código ya que si accedo al código, aunque meta una línea de comentarios, grabo y vuelva a abrir el fichero me da error....tengo que abrir el fichero, deshabilitando la macro y situado en cualquier parte del código y sin hacer nada le doy al icono de grabar, cierro el fichero y al volverlo a abrir la macro corre sin problemas....

Te envío el código en partes por límite de espacio:
De la macro faltan los formularios, se trata de una aplicación para sacar las ventas por Areas.

PARTE 1:

Sub extract_liste_services()
Sheets("admin").Select
Range("I1:I139").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("report").Range("AS6"), Unique:=True
Range("G1:G139").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("report").Range("A6"), Unique:=True
Sheets("admin").Select 'repite el proceso
Range("I1:I139").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("report").Range("AS6"), Unique:=True
Range("G1:G139").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("report").Range("A6"), Unique:=True
Sheets("REPORT").Select
Range("AS8").Select 'para desplazar el campo un renglon + arriba
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("AS7").Select
ActiveSheet.Paste
Range("A8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("A7").Select
ActiveSheet.Paste
Range("AS7").Select
Do While ActiveCell <> ""
USERGROUPII = ActiveCell.Value
ActiveCell.Offset(0, 1).FormulaR1C1 = "=CONCATENATE(RC[-1],R5C46)"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=CONCATENATE(RC[-2],R5C47)"
ActiveCell.Offset(0, 3).FormulaR1C1 = "=CONCATENATE(RC[-3],R5C48)"
ActiveCell.Offset(0, 4).FormulaR1C1 = "=CONCATENATE(RC[-4],R5C49)"
ActiveCell.Offset(1, 0).Select
Loop
End Sub


Sub extractweek()
unprotect
Sheets("REPORT").Select
Range("ax7:BU155").Select
Selection.ClearContents
Range("BJ6").Value = "ACTUAL"
Range("BK6").Value = "FC07"
Range("BL6").Value = "FC08"
Range("BM6").Value = "BP"
Range("BN6").Value = "LY"
Range("BO6").Value = "PY"
Range("AT6").Select
Do While ActiveCell <> ""
criteriaweek = ActiveCell.Value
ACTUAL = Application.VLookup(criteriaweek, Range("database"), 6, False)
FC07 = Application.VLookup(criteriaweek, Range("database"), 7, False)
FC08 = Application.VLookup(criteriaweek, Range("database"), 8, False)
BP = Application.VLookup(criteriaweek, Range("database"), 9, False)
ly = Application.VLookup(criteriaweek, Range("database"), 10, False)
PY = Application.VLookup(criteriaweek, Range("database"), 11, False)
If Not Application.IsNA(ACTUAL) Then
ActiveCell.Offset(0, 16) = ACTUAL
ActiveCell.Offset(0, 17) = FC07
ActiveCell.Offset(0, 18) = FC08
ActiveCell.Offset(0, 19) = BP
ActiveCell.Offset(0, 20) = ly
ActiveCell.Offset(0, 21) = PY
End If
vabas
Loop
extractweekminus1
extractweekmonthclosed
extractweekfy
Range("C7").Select
End Sub


Sub extractweekminus1()
Sheets("REPORT").Select
Range("AX6").Value = "ACTUAL"
Range("AY6").Value = "FC07"
Range("AZ6").Value = "FC08"
Range("BA6").Value = "BP"
Range("BB6").Value = "LY"
Range("BC6").Value = "PY"
Range("AU6").Select
Do While ActiveCell <> ""
criteriaminus1 = ActiveCell.Value
ACTUAL = Application.VLookup(criteriaminus1, Range("database"), 6, False)
FC07 = Application.VLookup(criteriaminus1, Range("database"), 7, False)
FC08 = Application.VLookup(criteriaminus1, Range("database"), 8, False)
BP = Application.VLookup(criteriaminus1, Range("database"), 9, False)
ly = Application.VLookup(criteriaminus1, Range("database"), 10, False)
PY = Application.VLookup(criteriaminus1, Range("database"), 11, False)
If Not Application.IsNA(ACTUAL) Then
ActiveCell.Offset(0, 3) = ACTUAL
ActiveCell.Offset(0, 4) = FC07
ActiveCell.Offset(0, 5) = FC08
ActiveCell.Offset(0, 6) = BP
ActiveCell.Offset(0, 7) = ly
ActiveCell.Offset(0, 8) = PY
End If
vabas
Loop
End Sub


Sub extractweekmonthclosed()
Sheets("REPORT").Select
Range("BD6").Value = "ACTUAL"
Range("BE6").Value = "FC07"
Range("BF6").Value = "FC08"
Range("BG6").Value = "BP"
Range("BH6").Value = "LY"
Range("BI6").Value = "PY"
Range("AV6").Select
Do While ActiveCell <> ""
criteriaclosing = ActiveCell.Value
ACTUAL = Application.VLookup(criteriaclosing, Range("database"), 6, False)
FC07 = Application.VLookup(criteriaclosing, Range("database"), 7, False)
FC08 = Application.VLookup(criteriaclosing, Range("database"), 8, False)
BP = Application.VLookup(criteriaclosing, Range("database"), 9, False)
ly = Application.VLookup(criteriaclosing, Range("database"), 10, False)
PY = Application.VLookup(criteriaclosing, Range("database"), 11, False)
If Not Application.IsNA(ACTUAL) Then
ActiveCell.Offset(0, 8) = ACTUAL
ActiveCell.Offset(0, 9) = FC07
ActiveCell.Offset(0, 10) = FC08
ActiveCell.Offset(0, 11) = BP
ActiveCell.Offset(0, 12) = ly
ActiveCell.Offset(0, 13) = PY
End If
vabas
Loop
End Sub


Sub extractweekfy()
Sheets("REPORT").Select
Range("BP6").Value = "ACTUAL"
Range("BQ6").Value = "FC07"
Range("BR6").Value = "FC08"
Range("BS6").Value = "BP"
Range("BT6").Value = "LY"
Range("BU6").Value = "PY"
Range("AW6").Select
Do While ActiveCell <> ""
criteriafy = ActiveCell.Value
ACTUAL = Application.VLookup(criteriafy, Range("database"), 6, False)
FC07 = Application.VLookup(criteriafy, Range("database"), 7, False)
FC08 = Application.VLookup(criteriafy, Range("database"), 8, False)
BP = Application.VLookup(criteriafy, Range("database"), 9, False)
ly = Application.VLookup(criteriafy, Range("database"), 10, False)
PY = Application.VLookup(criteriafy, Range("database"), 11, False)
If Not Application.IsNA(ACTUAL) Then
ActiveCell.Offset(0, 19) = ACTUAL
ActiveCell.Offset(0, 20) = FC07
ActiveCell.Offset(0, 21) = FC08
ActiveCell.Offset(0, 22) = BP
ActiveCell.Offset(0, 23) = ly
ActiveCell.Offset(0, 24) = PY
End If
vabas
Loop
End Sub

Sub vabas()
ActiveCell.Offset(1, 0).Select
End Sub

FIN PARTE 1

[08Alf]

PARTE 2:

Sub Formatbyentity()
Range("6:155").Select 'Para borrar todos los formatos de lineas, colores de celdas y letras
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.bold = False
Selection.Font.ColorIndex = 0

Range("A6").Select
Selection.Font.ColorIndex = 2 'to turn white "authorization right"
Selection.Font.bold = False
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).Weight = xlThick
Selection.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).Weight = xlThick
Selection.Borders(xlEdgeTop).ColorIndex = xlAutomatic
Range("A6:AP6").Select
Do While ActiveCell <> ""
COLOUR = 2
Select Case ActiveCell.Value

Case "Sales Area 1", "Sales Area 2", "Sales Area 3", "Sales Area 4", "Sales Area 5", "Intercompany Sales Area Total", "OEM, Hedge & Others"
COLOUR = 24
Selection.Font.bold = True
Selection.Font.ColorIndex = 5
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).Weight = xlThick
Selection.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).Weight = xlThick
Selection.Borders(xlEdgeTop).ColorIndex = xlAutomatic

Case "Total SNA Europe"
COLOUR = 5
Selection.Font.bold = True
Selection.Font.ColorIndex = 8
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).Weight = xlThick
Selection.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).Weight = xlThick
Selection.Borders(xlEdgeTop).ColorIndex = xlAutomatic


Case "AUTHORIZATION RIGHT", "Sales Area 1", "SU United Kingdom - Total", "SU Sweden - Total", "SU Norway - Total", "SU Denmark - Total", "SU Finland - Total", "SU Benelux - Total", "Su Au + Su NZ - Total", "SU Australia Sub-Total", "SU New Zealand Sub-Total", "Sales Area 2", "SU France Automobile - Total", "SU France Industries & Trade - Total", "SU France H&G & Green Ind - Total", "SU Germany - Total", "SU Italy - Total", "SU Switzerland & Austria - Total", "Sales Area 3", "SU Iberia Automobile - Total", "SU Iberia Green Industry - Total", "SU Iberia Industries - Total", "SU Iberia Irazola - Total", "SU Iberia Trades and H&G - Total", "Sales Area 4", "SU Argentina Domestic - Total", "SU Argentina Exports - Total", "SU Brasil - Total", "SU Chile - Total", "SU Poland - Total", "SU Russia - Total", "SU Turkey - Total", "SU Belarus - Total", "SU Ukraine - Total", "SU Greece - Total", "SU Hungary - Total", "Intercompany Sales Area Total", "Total Industrial WWW", "Total Snap-on Asia" _
, "Total Equipment WWW"
Selection.Font.bold = True

Case "CIS Region - Total", "PTHG Region - Total", "Latin America - Total", "International Sales Group - Total", "SNAP-ON Dealer Intercompany sales", "External Sales (IC responsibibility)", "SNAP-ON C&I Intercompany sales"
Selection.Font.bold = True
Selection.Font.ColorIndex = 5


'para hacer la linea bold de abajo
Case "SU New Zealand GBP Imports", "SU Switzerland EUR Imports", "Iberia Private Brand Sales", "ISG - ROW", "External Sales (IC responsibibility)", "HQ Adjustments & Others"
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End Select
Selection.Interior.ColorIndex = COLOUR
Selection.Offset(1, 0).Select
Loop
Range("A5:a155").Select

Range("A5").Select
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).Weight = xlThick
Selection.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
End Sub

Private Sub ESCAPE_Click()
UserForm_terminate
End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub reportarea_Click()
reportentity_Click
unprotect
Range("10:13,15:17,19:20,22:23,25:26,28:30,33:34,3 6:38,41:42,44:45,48:50,52:56,63:63,68:69,71:74,76: 77,79:80,83:84,86:87,91:93,97:102,105:107,109:110, 115:118,120:126,128:130,132:139,141:144").Select
Selection.EntireRow.Hidden = True
ActiveSheet.Shapes("PRINTBYENTITY").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTCONTEST").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTBYWEEK").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTAREA").Visible = True 'para mostrar el boton de impresion
ActiveSheet.Shapes("autoshape 1").Visible = True 'para mostrar el mensaje de como obtener un nuevo reporte
protect
End Sub

FIN PARTE 2

[08Alf]

PARTE 3:

Private Sub REPORTBYWEEK_Click()
If Range("ar5").Value = "" Then 'sino selecciona la unidad
MsgBox "Please selec the unit"
Me.WEEK.SetFocus
Exit Sub
End If
UserForm_terminate
wait
extractperweek
Range("5:280").Select
Selection.EntireRow.Hidden = True
Range("157:211").Select
Selection.EntireRow.Hidden = False
ActiveWindow.FreezePanes = False 'para adecuar el encuadre freeze panes
Range("C159").Select
ActiveWindow.FreezePanes = True
Range("H:H,L:L,R:R,V:V,X:X,Y:Y,AC:AC,AM:AM,AN:AN,A O:AO,AP:AP").Select 'PARA ESCONDER LAS COLUMNAS QUE NO QUIERO UTILIZAR
Selection.EntireColumn.Hidden = True
Range("C158").Select
ActiveSheet.Shapes("PRINTAREA").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTBYENTITY").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTCONTEST").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTBYWEEK").Visible = True 'para mostrar el boton de impresion
ActiveSheet.Shapes("autoshape 1").Visible = True 'para mostrar el mensaje de como obtener un nuevo reporte
endwait
protect
End Sub

Private Sub reportentity_Click()
If Range("at5").Value = "" Then 'sino selecciono la semana
MsgBox "Please select the week"
Me.WEEK.SetFocus
Exit Sub
End If
UserForm_terminate
wait
extractweek
Range("5:280").Select
Selection.EntireRow.Hidden = True
Range("5:155").Select
Selection.EntireRow.Hidden = False
Range("155:155").Select 'PARA ESCONDER LAS FILAS QUE QUEDAN VACIAS
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Range("155:155", Selection).Select
Selection.EntireRow.Hidden = True
ActiveWindow.FreezePanes = False
Range("a1").Select
Range("C7").Select
ActiveWindow.FreezePanes = True
Formatbyentity
Range("H:H,L:L,R:R,V:V,AB:AB,AF:AF,AG:AG,AL:AL,AM: AM,AN:AN,AO:AO,AP:AP").Select 'PARA ESCONDER LAS COLUMNAS QUE NO QUIERO UTILIZAR
Selection.EntireColumn.Hidden = True
Range("C7").Select
ActiveSheet.Shapes("PRINTAREA").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTCONTEST").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTBYWEEK").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTBYENTITY").Visible = True 'para mostrar el boton de impresion
ActiveSheet.Shapes("autoshape 1").Visible = True 'para hacer aparecer el mensaje de como obtener un nuevo reporte
endwait
protect
End Sub

Private Sub SALESCONTESTREPORT_Click()
If Range("at5").Value = "" Then 'sino selecciona la semana
MsgBox "Please select the week"
Me.WEEK.SetFocus
Exit Sub
End If
UserForm_terminate
wait
extract_sales_contest
SORT
Columns("B:AP").Select
Selection.EntireColumn.Hidden = False
Range("5:280").Select
Selection.EntireRow.Hidden = True
Range("215:260").Select
Selection.EntireRow.Hidden = False
Range("C260").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Range("260:260", Selection).Select
Selection.EntireRow.Hidden = True
ActiveWindow.FreezePanes = False
Range("C216").Select
ActiveWindow.FreezePanes = True
Range("C215").Select
SORT 'repito el sort porque sino no funciona
Unload Me
Columns("B:AP").Select
Selection.EntireColumn.Hidden = False
Range("5:280").Select
Selection.EntireRow.Hidden = True
Range("215:260").Select
Selection.EntireRow.Hidden = False
Range("C260").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Range("260:260", Selection).Select
Selection.EntireRow.Hidden = True
ActiveWindow.FreezePanes = False
Range("C216").Select
ActiveWindow.FreezePanes = True
Range("C215").Select
ActiveSheet.Shapes("PRINTAREA").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTBYENTITY").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTBYWEEK").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTCONTEST").Visible = True 'para mostrar el boton de impresion
ActiveSheet.Shapes("autoshape 1").Visible = True 'para mostrar el mensaje de como obtener un nuevo reporte
endwait
protect
End Sub

Private Sub UserForm_Initialize()
i = 7
Do While Cells(i, 1) <> ""
Me.ACCESSLIST.AddItem Cells(i, 1)
i = i + 1
Loop
Range("at5").Value = "" 'para poner en cero el campo de semana seleccionada
Range("ar5").Value = "" 'para poner en cero el campo de unidad seleccionada
ESCAPE.SetFocus
End Sub

Private Sub USERID_Click()

End Sub

FIN PARTE 3

[08Alf]

PARTE 4:

Private Sub WEEK_Click()
For i = 0 To 150
If ACCESSLIST.Selected(i) = True Then
ACCESSLIST.Selected(i) = False
End If
Next i

Range("at5").Value = WEEK
Range("ar5").Value = ""
REPORTENTITY.Visible = True
reportarea.Visible = True
SALESCONTESTREPORT.Visible = True
REPORTBYWEEK.Visible = False
REPORTENTITY.SetFocus
End Sub

Private Sub ACCESSLIST_Click()
For i = 0 To 55
If WEEK.Selected(i) = True Then
WEEK.Selected(i) = False
End If
Next i
Range("AR5").Value = ACCESSLIST
Range("at5").Value = ""
REPORTBYWEEK.Visible = True
REPORTENTITY.Visible = False
SALESCONTESTREPORT.Visible = False
REPORTBYWEEK.SetFocus
WEEK.Selected(i) = False
End Sub

Private Sub UserForm_terminate()
protect
Unload Me
ActiveSheet.Shapes("autoshape 1").Visible = True 'para mostrar el mensaje de como obtener un nuevo reporte
End Sub





Private Sub Workbook_Open()

ActiveWindow.DisplayHeadings = False ‘Esconde los numeros de las filas y las letras de las columnas.
Unprotect ‘Procedimiento para desproteger las hojas admin y report. (Module1)
BARRAOUT ‘Procedimiento que hace desaparecer las opciones del menu y solo queda Archivo y Ventana.
Sheets("admin").Select
ActiveSheet.Shapes("PANTALLA").Visible = True
For S = 3 To Sheets.Count ' esconde las hojas a partir de la segunda
Sheets(S).Visible = False
Next S
X = Environ("username") 'asigna a la variable X el valor del usuario de red
For u = 1 To Range("user").Count 'asigna a la variable i el valor de 1 a tantos usuarios como haya
If UCase(X) = UCase(Range("user")(u)) Then 'si X en uppercase es igual a alguno de los usuarios en uppercase
f = Range("feuille")(u) 'asigna a la variable F el valor de hoja de la variable i
Sheets(f).Visible = True 'hace visible la hoja que corresponde a la variable i
End If
Next u
Call search
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
closing
unprotect
Sheets("report").Select
Range("AR10").Select
Selection.ClearContents
ActiveWindow.DisplayHeadings = True
Application.DisplayFullScreen = False 'PARA PONER FULL SCREEN
BARRAIN
Sheets("Admin").Select
ActiveWindow.DisplayHeadings = True
Range("A1").Select
protect
End Sub

Private Sub CommandButton1_Click()
MEMO
End Sub
Sub extractperweek()
unprotect
Sheets("REPORT").Select
Range("ax159:bc210").Select
Selection.ClearContents
Range("C159").Select
Sheets("Database").Range("e5:k7340").AdvancedFilte r Action:=xlFilterCopy, CriteriaRange:=Sheets("REPORT").Range("AR6:AR7"), CopyToRange:=Range("ax158:bc158"), Unique:=False
End Sub


Sub extract_sales_contest() 'para extraer los datos para el sales contest
unprotect
Sheets("REPORT").Select
Range("BV216:CH260").Select 'para borrar los datos viejos
Selection.ClearContents
Sheets("admin").Select 'para transferir la lista de la hoja admin
Range("O1:O155").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("report").Range("BV215"), Unique:=True
Range("P1:P155").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("report").Range("BW215"), Unique:=True
Sheets("REPORT").Select
Range("BV217:BW217").Select 'para desplazar el campo un renglon + arriba
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("BV216").Select
ActiveSheet.Paste
Range("BV216").Select 'PARA CONCATENAR CON LA SEMANA
Do While ActiveCell <> ""
SALESCONTESTLIST = ActiveCell.Value
ActiveCell.Offset(0, 2).FormulaR1C1 = "=CONCATENATE(RC[-1],R5C46)"
ActiveCell.Offset(1, 0).Select
Loop
Range("BY215").Value = "ACTUAL"
Range("BZ215").Value = "FC07"
Range("CA215").Value = "FC08"
Range("CB215").Value = "BP"
Range("CC215").Value = "LY"
Range("CD215").Value = "PY"
Range("BX215").Select
Do While ActiveCell <> ""
salescontestweek = ActiveCell.Value
ACTUAL = Application.VLookup(salescontestweek, Range("database"), 6, False)
FC07 = Application.VLookup(salescontestweek, Range("database"), 7, False)
FC08 = Application.VLookup(salescontestweek, Range("database"), 8, False)
BP = Application.VLookup(salescontestweek, Range("database"), 9, False)
ly = Application.VLookup(salescontestweek, Range("database"), 10, False)
PY = Application.VLookup(salescontestweek, Range("database"), 11, False)
If Not Application.IsNA(ACTUAL) Then
ActiveCell.Offset(0, 1) = ACTUAL
ActiveCell.Offset(0, 2) = FC07
ActiveCell.Offset(0, 3) = FC08
ActiveCell.Offset(0, 4) = BP
ActiveCell.Offset(0, 5) = ly
ActiveCell.Offset(0, 6) = PY
End If
vabas
Loop
Range("BX216").Select 'PARA HACER LOS CALCULOS CONTRA LAS CIFRAS REALES
Do While ActiveCell <> ""
salescontestweek = ActiveCell.Value
ActiveCell.Offset(0, 7).FormulaR1C1 = "=RC[-6]-RC[-3]"
ActiveCell.Offset(0, 8).FormulaR1C1 = "=RC[-7]/RC[-4]"
ActiveCell.Offset(0, 9).FormulaR1C1 = "=RC[-8]-RC[-4]"
ActiveCell.Offset(0, 10).FormulaR1C1 = "=RC[-9]-RC[-4]"
vabas
Loop
Range("BV216:CH260").Select 'PARA COPIAR Y PEGAR VALORES
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("BV216:BV260").Select 'PARA MOVER A LA PRESENTACION
Selection.Copy
Range("C216").Select
ActiveSheet.Paste
Range("G216").Select
ActiveSheet.Paste
Range("K216").Select
ActiveSheet.Paste
Range("CE216:CE260").Select 'PARA COPIAR Y PEGAR LAS CIFRAS
Selection.Copy
Range("E216").Select
ActiveSheet.Paste
Range("CF216:CF260").Select
Selection.Copy
Range("I216").Select
ActiveSheet.Paste
Range("CG216:CG260").Select
Selection.Copy
Range("M216").Select
ActiveSheet.Paste
End Sub







Sub SORT()
Range("C216").Select 'PARA ORDENAR DECRECIENTE
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SORT Key1:=Range("E216"), Order1:=xlDescending, Header:=xlGuess, Orientation:=xlTopToBottom
Range("G216").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SORT Key1:=Range("I216"), Order1:=xlDescending, Header:=xlGuess, Orientation:=xlTopToBottom
Range("K216").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SORT Key1:=Range("M216"), Order1:=xlDescending, Header:=xlGuess, Orientation:=xlTopToBottom
End Sub

FIN PARTE 4

[08Alf]

....y todavía quedan muchas mas páginas...pero no te quiero aburrir....

GRacias