répéter une macro avec décalage de ligne

[jad73]

bonjour le forum
Dans le fichier joint j'ai fait une macro mais j'aimerais qu'elle se répéte plusieurs fois jusqu'a la fin du fichier,comment inscrire cela dans la macro
Dans le fichier joint j'ai mis quelques explications.
merci

 

[bérylion]

Re : répéter une macro avec décalage de ligne

Salut

bon, j'ai pas retaillé le reste du code, mais ça pourrait donner qqch comme :

Sub test5()
'
' test5 Macro
'

For i% = 0 To Range(Range("X50"), Range("X50").End(xlDown)).Count - 1

    With Range("X50:AQ50").Offset(i, 0).Select
    Selection.Cut Destination:=Range("C50:V50").Offset(i, 0)
    Range("C50:V50").Offset(i, 0).Select
    Selection.Copy
    Range("X43").Offset(i, 0).Select
    ActiveSheet.Paste
    Range("X47").Offset(i, 0).Select
    Application.CutCopyMode = False
    Calculate
    vLigne = Range("AY65536").End(xlUp).Row
    vLigne = vLigne + 1
    Range("X45:AQ45").Select 'ne change pas
    Application.CutCopyMode = False
    Selection.Copy
    Range("AY" & vLigne).Select  'ne change pas
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("X43:AQ43").Offset(i, 0).Select
    Selection.ClearContents
    Range("X43").Offset(i, 0).Select
    Calculate
    Range("AS50:AT119").Offset(i, 0).Select
    Selection.Copy
    Range("AV50").Offset(i, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
        "AW50:AW119"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("AV50:AW119")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Calculate
    Range("X48").Offset(i, 0).Select
Next
End Sub

le principe est la, à toi d'adapter...

Enjoy !!

😉

 

[jad73]

Re : répéter une macro avec décalage de ligne

bonjour bérylion,le forum
je viens de rentrer votre code mais j'ai un message d'erreur"erreur de compilation Next sans For"
pourtant il y a For en 1ere ligne.ou est l'erreur.
merci

 

[bérylion]

Re : répéter une macro avec décalage de ligne

re-

boulette de ma part ?

essaie en virant le "with" de la 2eme ligne :

With Range("X50:AQ50").Offset(i, 0).Select

(uniquement le mot, surtout pas la ligne complete !)

 

[jad73]

Re : répéter une macro avec décalage de ligne

bonjour bérylion,le forum
j'ai rectifié le code et la macro fonctionne sauf qu'elle efface la ligne X45:A45 ligne ou se trouve des formules qui servent chaque fois qu'une ligne est inscrite en X43 et je ne vois pas ou ça se passe dans la macro.Je joint le fichier rectifié clique sur "test6" pour voir ce qui se passe
merci

 

[bérylion]

Re : répéter une macro avec décalage de ligne

re-

j'ai pas trop creusé, mais ça devrait faire la maille :

Sub test6()
 '
 ' test5 Macro
 '
 
For i% = 0 To Range(Range("X50"), Range("X50").End(xlDown)).Count - 1
 
     Range("X50:AQ50").Offset(i, 0).Select
     Selection.Cut Destination:=Range("C50:V50").Offset(i, 0)
     Range("C50:V50").Offset(i, 0).Select
     Selection.Copy
     Range("X43").Select
     ActiveSheet.Paste
     Range("X47").Offset(i, 0).Select
     Application.CutCopyMode = False
     Calculate
     'vLigne = Range("AY65536").End(xlUp).Row
     'vLigne = vLigne + 1
     Range("X45:AQ45").Select 'ne change pas
     'Application.CutCopyMode = False
     Selection.Copy
     Range("AY2").Offset(i, 0).Select
     'Range("AY" & vLigne).Select  'ne change pas
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
     Range("X43:AQ43").ClearContents
     Range("X43").Offset(i, 0).Select
     Calculate
     Range("AS50:AT119").Offset(i, 0).Select
     Selection.Copy
     Range("AV50").Offset(i, 0).Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
     Application.CutCopyMode = False
     ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
     ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
         "AW50:AW119"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
         xlSortNormal
     With ActiveWorkbook.Worksheets("Feuil1").Sort
         .SetRange Range("AV50:AW119")
         .Header = xlGuess
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
     Calculate
     Range("X48").Offset(i, 0).Select
 Next
 End Sub