| Re: Macro en Excel
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 |