XL 2013 repeter une action plusieurs fois

cabaniais

XLDnaute Nouveau
bonjour
je voudrais qu'a l'ouverture de mon dossier cette action se repete 3 fois .
j'ai reussi a le faire en copiant 3 fois la meme macro.
ce que je voudrais c'est faire une boucle pour que ce soit plus simple.
voici ma macro
merci d'avance
Private Sub Workbook_Open()

Range("j2").Select
If Selection <= Date Then
Range("j2;p2").Select
Selection.Copy
Range("A15:G15").Select
Selection.Insert Shift:=xlDown
Range("j2").Select
Application.CutCopyMode = False
Range("m2").Select
If ActiveCell = "eurofil" Then
Range("j2") = DateAdd("m", 3, Range("j2"))
Application.CutCopyMode = False
Else: Range("j2") = DateAdd("m", 1, Range("j2"))
End If
End If

Range("J2;13").Select
ActiveWorkbook.Worksheets("ccp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ccp").Sort.SortFields.Add Key:=Range("J2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ccp").Sort
.SetRange Range("J2;13")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Range("j2").Select
If Selection <= Date Then
Range("j2;p2").Select
Selection.Copy
Range("A15:G15").Select
Selection.Insert Shift:=xlDown
Range("j2").Select
Application.CutCopyMode = False
Range("m2").Select
If ActiveCell = "eurofil" Then
Range("j2") = DateAdd("m", 3, Range("j2"))
Application.CutCopyMode = False
Else: Range("j2") = DateAdd("m", 1, Range("j2"))
End If
End If

Range("J2;13").Select
ActiveWorkbook.Worksheets("ccp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ccp").Sort.SortFields.Add Key:=Range("J2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ccp").Sort
.SetRange Range("J2;13")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("j2").Select
If Selection <= Date Then
Range("j2;p2").Select
Selection.Copy
Range("A15:G15").Select
Selection.Insert Shift:=xlDown
Range("j2").Select
Application.CutCopyMode = False
Range("m2").Select
If ActiveCell = "eurofil" Then
Range("j2") = DateAdd("m", 3, Range("j2"))
Application.CutCopyMode = False
Else: Range("j2") = DateAdd("m", 1, Range("j2"))
End If
End If

Range("J2;13").Select
ActiveWorkbook.Worksheets("ccp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ccp").Sort.SortFields.Add Key:=Range("J2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ccp").Sort
.SetRange Range("J2;13")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub
 
Dernière édition:

vgendron

XLDnaute Barbatruc
sinon, ton code allégé, et corrigé donnerait ceci
VB:
For i = 1 To 3
    If Range("j2") <= Date Then
        Range("j2:p2").Copy
        Range("A15:G15").Insert Shift:=xlDown
        Application.CutCopyMode = False
        If Range("m2") = "eurofil" Then
            Range("j2") = DateAdd("m", 3, Range("j2"))
        Else: Range("j2") = DateAdd("m", 1, Range("j2"))
        End If
    End If
   
    ActiveWorkbook.Worksheets("ccp").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ccp").Sort.SortFields.Add Key:=Range("J2"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("ccp").Sort
        .SetRange Range("J2:13")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next i
 

cabaniais

XLDnaute Nouveau
sinon, ton code allégé, et corrigé donnerait ceci
VB:
For i = 1 To 3
    If Range("j2") <= Date Then
        Range("j2:p2").Copy
        Range("A15:G15").Insert Shift:=xlDown
        Application.CutCopyMode = False
        If Range("m2") = "eurofil" Then
            Range("j2") = DateAdd("m", 3, Range("j2"))
        Else: Range("j2") = DateAdd("m", 1, Range("j2"))
        End If
    End If
  
    ActiveWorkbook.Worksheets("ccp").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ccp").Sort.SortFields.Add Key:=Range("J2"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("ccp").Sort
        .SetRange Range("J2:13")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next i

/code][/QUOTE]
ok merci beaucoup c'est exactement ce que je voulais faire. et en plus c'est beaucoup plus simple. c'est ma 1er "creation" en macro et j'avais reussi  a faire quelque chose  mais en compliquant la macro.
merci encore
 

Discussions similaires

Réponses
3
Affichages
568

Statistiques des forums

Discussions
312 082
Messages
2 085 171
Membres
102 805
dernier inscrit
emes