Appliquer une formule sur une colonne VBA

Edouard -
melanie1324 Messages postés 1561 Statut Membre - 15 nov. 2013 à 09:50

Bonjour,

je souhaite appliquer la formule suivante sur toute la colonne, comment faire?

If Range("A2").Value = "0" And Range("B2").Value = "0" Then Range("C2").Value = Format(Date, "mm/dd/yyyy")

Merci de votre aide

Afficher la suite

1 réponse

Réponse 1 / 1
melanie1324 Messages postés 1561 Statut Membre 156

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
0
1. edouard
  
  Merci,
  Cela fonctionne mais uniquement seule, elle m'indique erreur 13, lorsque je l'ajoute à ma macro.
  Que dois-je rejouter?
  
  0
2. melanie1324 Messages postés 1561 Statut Membre 156
  
  Dans un premier temps essaie de modifier comme ca :
  
  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.
  
  0
3. edouard
  
  Voilà ma Macro, elle est un peu longue, la partie que nous intêresse est à la fin
  
  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
  
  0
4. edouard
  
  As tu une solution? la fonction s'applique mais elle fait planter la suite de la macro
  
  0
5. melanie1324 Messages postés 1561 Statut Membre 156
  
  J'ai trouvé l'erreur. J'en ai profité pour supprimer les lignes inutiles et de modifier certaines choses :
  
  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
  
  0

Newsletters