Appliquer une formule sur une colonne VBA
Fermé
Edouard
-
8 nov. 2013 à 14:36
melanie1324 Messages postés 1505 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 - 15 nov. 2013 à 09:50
melanie1324 Messages postés 1505 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 - 15 nov. 2013 à 09:50
A voir également:
- Appliquer une formule à toute une colonne excel vba
- Formule excel - Guide
- Déplacer une colonne excel - Guide
- Formule somme excel colonne - Guide
- Liste déroulante excel - Guide
- Formule moyenne excel - Guide
1 réponse
melanie1324
Messages postés
1505
Date d'inscription
vendredi 25 mai 2007
Statut
Membre
Dernière intervention
31 janvier 2018
154
8 nov. 2013 à 14:53
8 nov. 2013 à 14:53
Bonjour,
for i= 2 to 1000 's'appliqueras de la ligne 2 à 1000 :
If cells(i,1).Value = "0" And cells(i,2).Value = "0" Then cells(i,3).Value = Format(Date, "mm/dd/yyyy")
end if
next
for i= 2 to 1000 's'appliqueras de la ligne 2 à 1000 :
If cells(i,1).Value = "0" And cells(i,2).Value = "0" Then cells(i,3).Value = Format(Date, "mm/dd/yyyy")
end if
next
13 nov. 2013 à 15:56
Cela fonctionne mais uniquement seule, elle m'indique erreur 13, lorsque je l'ajoute à ma macro.
Que dois-je rejouter?
13 nov. 2013 à 16:03
dim i as variant
for i= 2 to 1000 's'appliqueras de la ligne 2 à 1000 :
If cells(i,1).Value = "0" And cells(i,2).Value = "0" Then cells(i,3).Value = Format(Date, "mm/dd/yyyy")
end if
next
Sinon, il faudrait que je puisse voir ta macro soit en la copiant collant ici soit en mettant ton fichier sur cjoint et en mettant le lien ici.
13 nov. 2013 à 16:11
Sub Macro2()
'
' Macro2 Macro
'
'
Sheets("Nombre de ruptures par IPP").Select
Sheets("ZMM8").Visible = True
Sheets("Nombre de ruptures par IPP").Select
Sheets("Liste des Causes").Visible = True
Sheets("Liste des Causes").Select
Sheets("EXTRACT°").Visible = True
Sheets("ZMM8").Select
ChDir "W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A"
Workbooks.Open Filename:= _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A\export.MHTML"
Columns("A:AJ").Select
Selection.Copy
Windows("Fichier Rupture sur les A.xlsm").Activate
ActiveSheet.Paste
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("EXTRACT°").Select
ActiveSheet.Paste
Range("B1").Select
Sheets("ZMM8").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
Columns("Y:Y").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("EXTRACT°").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Sheets("MRP").Select
Windows("export.MHTML").Activate
Range("A1").Select
ActiveWindow.Close
Workbooks.Open Filename:= _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A\Fichier veille1.xlsx"
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("L3").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-11],'[Fichier veille1.xlsx]MRP'!C1:C15,12,FALSE)"
Range("L3").Select
Selection.AutoFill Destination:=Range("L3:L961")
Range("L3:L961").Select
Range("M3").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-12],'[Fichier veille1.xlsx]MRP'!C1:C15,13,FALSE)"
Range("M3").Select
Selection.AutoFill Destination:=Range("M3:M961")
Range("M3:M961").Select
Range("N3").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-13],'[Fichier veille1.xlsx]MRP'!C1:C15,14,FALSE)"
Range("N3").Select
Selection.AutoFill Destination:=Range("N3:N961")
Range("N3:N961").Select
Range("O3").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-14],'[Fichier veille1.xlsx]MRP'!C1:C15,15,FALSE)"
Range("O3").Select
Selection.AutoFill Destination:=Range("O3:O961")
Range("O3:O961").Select
Sheets("ZMM8").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("EXTRACT°").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("MRP").Select
Range("L2:O961").Select
ActiveWindow.ScrollRow = 926
ActiveWindow.ScrollRow = 925
ActiveWindow.ScrollRow = 915
ActiveWindow.ScrollRow = 907
ActiveWindow.ScrollRow = 898
ActiveWindow.ScrollRow = 886
ActiveWindow.ScrollRow = 870
ActiveWindow.ScrollRow = 853
ActiveWindow.ScrollRow = 834
ActiveWindow.ScrollRow = 810
ActiveWindow.ScrollRow = 778
ActiveWindow.ScrollRow = 745
ActiveWindow.ScrollRow = 719
ActiveWindow.ScrollRow = 694
ActiveWindow.ScrollRow = 664
ActiveWindow.ScrollRow = 643
ActiveWindow.ScrollRow = 613
ActiveWindow.ScrollRow = 580
ActiveWindow.ScrollRow = 546
ActiveWindow.ScrollRow = 516
ActiveWindow.ScrollRow = 483
ActiveWindow.ScrollRow = 446
ActiveWindow.ScrollRow = 414
ActiveWindow.ScrollRow = 374
ActiveWindow.ScrollRow = 345
ActiveWindow.ScrollRow = 312
ActiveWindow.ScrollRow = 276
ActiveWindow.ScrollRow = 254
ActiveWindow.ScrollRow = 233
ActiveWindow.ScrollRow = 215
ActiveWindow.ScrollRow = 200
ActiveWindow.ScrollRow = 187
ActiveWindow.ScrollRow = 175
ActiveWindow.ScrollRow = 161
ActiveWindow.ScrollRow = 147
ActiveWindow.ScrollRow = 134
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 110
ActiveWindow.ScrollRow = 96
ActiveWindow.ScrollRow = 83
ActiveWindow.ScrollRow = 69
ActiveWindow.ScrollRow = 58
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 3
Range("L3:O962").Select
Selection.Copy
ActiveWindow.ScrollRow = 925
ActiveWindow.ScrollRow = 920
ActiveWindow.ScrollRow = 907
ActiveWindow.ScrollRow = 893
ActiveWindow.ScrollRow = 874
ActiveWindow.ScrollRow = 822
ActiveWindow.ScrollRow = 743
ActiveWindow.ScrollRow = 660
ActiveWindow.ScrollRow = 549
ActiveWindow.ScrollRow = 466
ActiveWindow.ScrollRow = 401
ActiveWindow.ScrollRow = 341
ActiveWindow.ScrollRow = 295
ActiveWindow.ScrollRow = 261
ActiveWindow.ScrollRow = 233
ActiveWindow.ScrollRow = 220
ActiveWindow.ScrollRow = 210
ActiveWindow.ScrollRow = 201
ActiveWindow.ScrollRow = 192
ActiveWindow.ScrollRow = 184
ActiveWindow.ScrollRow = 179
ActiveWindow.ScrollRow = 174
ActiveWindow.ScrollRow = 168
ActiveWindow.ScrollRow = 162
ActiveWindow.ScrollRow = 157
ActiveWindow.ScrollRow = 153
ActiveWindow.ScrollRow = 150
ActiveWindow.ScrollRow = 142
ActiveWindow.ScrollRow = 136
ActiveWindow.ScrollRow = 128
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 115
ActiveWindow.ScrollRow = 108
ActiveWindow.ScrollRow = 102
ActiveWindow.ScrollRow = 97
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 87
ActiveWindow.ScrollRow = 83
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 65
ActiveWindow.ScrollRow = 60
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 3
Range("L3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L10").Select
Application.CutCopyMode = False
Range("L3").Select
Sheets("Liste des Causes").Select
ActiveWindow.SelectedSheets.Visible = False
Range("D3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A3:B3").Select
Sheets("Nombre de ruptures par IPP").Select
Sheets("Liste des Causes").Visible = True
Sheets("MRP").Select
ActiveSheet.Range("$A$2:$N$961").AutoFilter Field:=11, Criteria1:="0"
ActiveSheet.Range("$A$2:$N$961").AutoFilter Field:=12, Criteria1:="0"
Range("L14").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Liste des Causes'!$A$20:$A$27"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ActiveWindow.ScrollRow = 1048538
ActiveWindow.ScrollRow = 1045685
ActiveWindow.ScrollRow = 1037125
ActiveWindow.ScrollRow = 1025713
ActiveWindow.ScrollRow = 1011447
ActiveWindow.ScrollRow = 995755
ActiveWindow.ScrollRow = 978636
ActiveWindow.ScrollRow = 958664
ActiveWindow.ScrollRow = 938691
ActiveWindow.ScrollRow = 920146
ActiveWindow.ScrollRow = 901600
ActiveWindow.ScrollRow = 868789
ActiveWindow.ScrollRow = 823139
ActiveWindow.ScrollRow = 774635
ActiveWindow.ScrollRow = 728984
ActiveWindow.ScrollRow = 684761
ActiveWindow.ScrollRow = 647670
ActiveWindow.ScrollRow = 612005
ActiveWindow.ScrollRow = 579194
ActiveWindow.ScrollRow = 550662
ActiveWindow.ScrollRow = 522131
ActiveWindow.ScrollRow = 495026
ActiveWindow.ScrollRow = 476480
ActiveWindow.ScrollRow = 456508
ActiveWindow.ScrollRow = 440816
ActiveWindow.ScrollRow = 425123
ActiveWindow.ScrollRow = 409431
ActiveWindow.ScrollRow = 393739
ActiveWindow.ScrollRow = 379473
ActiveWindow.ScrollRow = 360927
ActiveWindow.ScrollRow = 345235
ActiveWindow.ScrollRow = 326689
ActiveWindow.ScrollRow = 310997
ActiveWindow.ScrollRow = 293878
ActiveWindow.ScrollRow = 278186
ActiveWindow.ScrollRow = 262493
ActiveWindow.ScrollRow = 248228
ActiveWindow.ScrollRow = 236815
ActiveWindow.ScrollRow = 222549
ActiveWindow.ScrollRow = 211137
ActiveWindow.ScrollRow = 198297
ActiveWindow.ScrollRow = 188311
ActiveWindow.ScrollRow = 178325
ActiveWindow.ScrollRow = 171192
ActiveWindow.ScrollRow = 161206
ActiveWindow.ScrollRow = 155500
ActiveWindow.ScrollRow = 146941
ActiveWindow.ScrollRow = 139808
ActiveWindow.ScrollRow = 135528
ActiveWindow.ScrollRow = 131248
ActiveWindow.ScrollRow = 126968
ActiveWindow.ScrollRow = 124115
ActiveWindow.ScrollRow = 119836
ActiveWindow.ScrollRow = 116982
ActiveWindow.ScrollRow = 112703
ActiveWindow.ScrollRow = 109850
ActiveWindow.ScrollRow = 105570
ActiveWindow.ScrollRow = 99863
ActiveWindow.ScrollRow = 94157
ActiveWindow.ScrollRow = 88451
ActiveWindow.ScrollRow = 84171
ActiveWindow.ScrollRow = 79891
ActiveWindow.ScrollRow = 74185
ActiveWindow.ScrollRow = 69905
ActiveWindow.ScrollRow = 65626
ActiveWindow.ScrollRow = 61346
ActiveWindow.ScrollRow = 57066
ActiveWindow.ScrollRow = 52786
ActiveWindow.ScrollRow = 49933
ActiveWindow.ScrollRow = 42800
ActiveWindow.ScrollRow = 38521
ActiveWindow.ScrollRow = 34241
ActiveWindow.ScrollRow = 29961
ActiveWindow.ScrollRow = 25681
ActiveWindow.ScrollRow = 21402
ActiveWindow.ScrollRow = 18549
ActiveWindow.ScrollRow = 15695
ActiveWindow.ScrollRow = 11416
ActiveWindow.ScrollRow = 9989
ActiveWindow.ScrollRow = 7136
ActiveWindow.ScrollRow = 5709
ActiveWindow.ScrollRow = 4283
ActiveWindow.ScrollRow = 2856
ActiveWindow.ScrollRow = 1430
ActiveWindow.ScrollRow = 3
Range("M14").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Liste des Causes'!$B$2:$B$16"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ActiveWindow.ScrollRow = 1048538
ActiveWindow.ScrollRow = 1047111
ActiveWindow.ScrollRow = 1045685
ActiveWindow.ScrollRow = 1039979
ActiveWindow.ScrollRow = 1034272
ActiveWindow.ScrollRow = 1028566
ActiveWindow.ScrollRow = 1020006
ActiveWindow.ScrollRow = 1012874
ActiveWindow.ScrollRow = 1000034
ActiveWindow.ScrollRow = 987195
ActiveWindow.ScrollRow = 967223
ActiveWindow.ScrollRow = 947251
ActiveWindow.ScrollRow = 925852
ActiveWindow.ScrollRow = 900174
ActiveWindow.ScrollRow = 867363
ActiveWindow.ScrollRow = 837404
ActiveWindow.ScrollRow = 796034
ActiveWindow.ScrollRow = 760369
ActiveWindow.ScrollRow = 718998
ActiveWindow.ScrollRow = 670495
ActiveWindow.ScrollRow = 630551
ActiveWindow.ScrollRow = 597739
ActiveWindow.ScrollRow = 573487
ActiveWindow.ScrollRow = 552089
ActiveWindow.ScrollRow = 530690
ActiveWindow.ScrollRow = 512145
ActiveWindow.ScrollRow = 490746
ActiveWindow.ScrollRow = 472200
ActiveWindow.ScrollRow = 453655
ActiveWindow.ScrollRow = 435109
ActiveWindow.ScrollRow = 415137
ActiveWindow.ScrollRow = 393739
ActiveWindow.ScrollRow = 375193
ActiveWindow.ScrollRow = 355221
ActiveWindow.ScrollRow = 335249
ActiveWindow.ScrollRow = 319557
ActiveWindow.ScrollRow = 305291
ActiveWindow.ScrollRow = 292452
ActiveWindow.ScrollRow = 279612
ActiveWindow.ScrollRow = 266773
ActiveWindow.ScrollRow = 253934
ActiveWindow.ScrollRow = 241095
ActiveWindow.ScrollRow = 226829
ActiveWindow.ScrollRow = 215416
ActiveWindow.ScrollRow = 205430
ActiveWindow.ScrollRow = 196871
ActiveWindow.ScrollRow = 188311
ActiveWindow.ScrollRow = 178325
ActiveWindow.ScrollRow = 164059
ActiveWindow.ScrollRow = 154073
ActiveWindow.ScrollRow = 142661
ActiveWindow.ScrollRow = 132675
ActiveWindow.ScrollRow = 121262
ActiveWindow.ScrollRow = 106996
ActiveWindow.ScrollRow = 95584
ActiveWindow.ScrollRow = 85598
ActiveWindow.ScrollRow = 77038
ActiveWindow.ScrollRow = 68479
ActiveWindow.ScrollRow = 62772
ActiveWindow.ScrollRow = 61346
ActiveWindow.ScrollRow = 58493
ActiveWindow.ScrollRow = 55640
ActiveWindow.ScrollRow = 54213
ActiveWindow.ScrollRow = 51360
ActiveWindow.ScrollRow = 47080
ActiveWindow.ScrollRow = 42800
ActiveWindow.ScrollRow = 37094
ActiveWindow.ScrollRow = 29961
ActiveWindow.ScrollRow = 24255
ActiveWindow.ScrollRow = 19975
ActiveWindow.ScrollRow = 15695
ActiveWindow.ScrollRow = 12842
ActiveWindow.ScrollRow = 9989
ActiveWindow.ScrollRow = 8562
ActiveWindow.ScrollRow = 7136
ActiveWindow.ScrollRow = 5709
ActiveWindow.ScrollRow = 4283
ActiveWindow.ScrollRow = 2856
ActiveWindow.ScrollRow = 1430
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A14").Select
Sheets("Liste des Causes").Select
ActiveWindow.SelectedSheets.Visible = False
Range("B3:C3").Select
Range("E3") = Date
ChDir _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A"
Workbooks.Open Filename:= _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A\Evolution Synthèse.xlsx"
Windows("Fichier Rupture sur les A.xlsm").Activate
ActiveWindow.SmallScroll Down:=15
Range("C34").Select
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Sheets("Evolut°-Détails").Select
Range("F400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("F34").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("H400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.SmallScroll Down:=-21
Range("M8:M9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("I400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("M10:M11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("K400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("M12:M13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("M400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K23").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("Q400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Windows("Evolution Synthèse.xlsx").Activate
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K17").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("S400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("U400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K19").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("W400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K20").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("Y400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K21").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("AA400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K22").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("AC400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K24").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("AE400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
Windows("Fichier Rupture sur les A.xlsm").Activate
ActiveWindow.SmallScroll ToRight:=5
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("K25").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("AG400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
Windows("Fichier Rupture sur les A.xlsm").Activate
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
Range("K8:K9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Sheets("Feuil3").Select
ActiveWindow.SmallScroll Down:=45
Range("B400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K10:K11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("D400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K12:K13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("F400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-45
Windows("Fichier Rupture sur les A.xlsm").Activate
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Windows("Evolution Synthèse.xlsx").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Range("B3:C3").Select
Sheets("MRP").Select
for i= 3 to 1000
If cells(i,11).Value = "0" And cells(i,12).Value = "0" Then cells(i,16).Value = Format(Date, "mm/dd/yyyy")
end if
ChDir "W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A"
ActiveWorkbook.SaveAs Filename:= _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Taux de service A -" & Format(Date, "yyyy.mm.dd") & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ChDir "W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A"
ActiveWorkbook.SaveAs Filename:= _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A\Fichier veille1.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
14 nov. 2013 à 09:03
14 nov. 2013 à 10:00
Sub Macro2()
'
' Macro2 Macro
'
'
'toute cette partie a été remplacée parlaboucle for ca gagne du temps
'Sheets("Nombre de ruptures par IPP").Select
'Sheets("ZMM8").Visible = True
'Sheets("Nombre de ruptures par IPP").Select
'Sheets("Liste des Causes").Visible = True
'Sheets("Liste des Causes").Select
'Sheets("EXTRACT°").Visible = True
For i = 1 To Sheets.Count
Sheets(i).Visible = True
Next
ChDir "W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A"
Workbooks.Open Filename:= _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A\export.MHTML"
Columns("A:AJ").Copy
Windows("Fichier Rupture sur les A.xlsm").Activate
ActiveSheet.Paste
Columns("E:E").Copy
Sheets("EXTRACT°").Select
ActiveSheet.Paste
Sheets("ZMM8").Select
Columns("Y:Y").Copy
Sheets("EXTRACT°").Select
Cells(1, 25).Select
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Windows("export.MHTML").Close
Workbooks.Open Filename:= _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A\Fichier veille1.xlsx"
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("L3").FormulaR1C1 = _
"=VLOOKUP(RC[-11],'[Fichier veille1.xlsx]MRP'!C1:C15,12,FALSE)"
Range("M3").FormulaR1C1 = _
"=VLOOKUP(RC[-12],'[Fichier veille1.xlsx]MRP'!C1:C15,13,FALSE)"
Range("N3").FormulaR1C1 = _
"=VLOOKUP(RC[-13],'[Fichier veille1.xlsx]MRP'!C1:C15,14,FALSE)"
Range("O3").FormulaR1C1 = _
"=VLOOKUP(RC[-14],'[Fichier veille1.xlsx]MRP'!C1:C15,15,FALSE)"
'copie les formules de L à O sur toutes les lignes
i = 3
Do While Cells(i, 12) <> ""
i = i + 1
Loop
Range(Cells(3, 12), Cells(3, 15)).Copy
Range(Cells(3, 12), Cells(i, 12)).Select
ActiveSheet.Paste
Range(Cells(3, 12), Cells(i, 12)).Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("ZMM8").Visible = False
Sheets("EXTRACT°").Visible = False
Sheets("Liste des Causes").Visible = False
Range("D3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A3:B3").Select
Sheets("Nombre de ruptures par IPP").Select
Sheets("Liste des Causes").Visible = True
Sheets("MRP").Select
ActiveSheet.Range("$A$2:$N$961").AutoFilter Field:=11, Criteria1:="0"
ActiveSheet.Range("$A$2:$N$961").AutoFilter Field:=12, Criteria1:="0"
Range("L14").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Liste des Causes'!$A$20:$A$27"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("M14").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Liste des Causes'!$B$2:$B$16"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("A14").Select
Sheets("Liste des Causes").Visible = False
Range("B3:C3").Select
Range("E3") = Date
ChDir _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A"
Workbooks.Open Filename:= _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A\Evolution Synthèse.xlsx"
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("C34").Select
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Sheets("Evolut°-Détails").Select
Range("F400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("F34").Select
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("H400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("M8:M9").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("I400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("M10:M11").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("K400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("M12:M13").Select
Application.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("M400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K23").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("Q400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K17").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("S400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("U400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K19").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("W400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K20").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("Y400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K21").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("AA400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K22").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("AC400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K24").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("AE400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K25").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("AG400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K8:K9").Copy
Windows("Evolution Synthèse.xlsx").Activate
Sheets("Feuil3").Select
Range("B400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K10:K11").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("D400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fichier Rupture sur les A.xlsm").Activate
Range("K12:K13").Copy
Windows("Evolution Synthèse.xlsx").Activate
Range("F400").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Evolution Synthèse.xlsx").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Range("B3:C3").Select
Sheets("MRP").Select
For i = 3 To 1000
If Cells(i, 11).Value = "0" And Cells(i, 12).Value = "0" Then Cells(i, 16) = Format(Date, "mm/dd/yyyy")
Next
ChDir "W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A"
ActiveWorkbook.SaveAs Filename:= _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Taux de service A -" & Format(Date, "yyyy.mm.dd") & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ChDir "W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A"
ActiveWorkbook.SaveAs Filename:= _
"W:\Projet Sun\Outils\ANALYSTES\SUIVI DES RUPTURES SUR LES A\Projet rupture sur les A\Calcul journalier du taux de service A\Macro Taux de service A\Fichier veille1.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub