Macro monter / descendre ligne sans modifier le formatage conditionnel

Bonjour, cela fait quelques temps que je parcours le forum et je dois dire que c'est une vraie mine d'informations. Cette fois-ci je suis bloqué car mes connaissances en VBA sont quasi-nulles, je ne fais qu'adapter des macros que je dénicher sur le net.

Ci-joint le fichier en question avec exemple. Je souhaite avoir un bouton pour descendre une ligne d'un cran et un autre pour les descendre. J'ai réussi cela.

Le problème est que j'ai un formatage conditionnel qui me donne une ligne sur deux colorée. Et le fait de monter ou descendre les lignes modifie ma règle de formatage et en créé d'autres, ça fout tout en l'air. La seule solution que j'ai trouvé pour le moment est de supprimer la règle de formatage qui fait les lignes colorées une sur deux mais dans l'idéal j'aimerais la conserver.

Voici le code des macros descente / monter :

Sub monter()
' ll nombre de lignes de la sélection
ll = Selection.Rows.Count
'fl première ligne de la sélection
fl = Selection.Cells(1, 1).Row

' couper la ligne précédant la sélection
Rows(fl - 1).Cut
' insérer la ligne après la sélection et décalant les autres lignes vers le bas
Rows(fl + ll).Insert Shift:=xlDown
Application.CutCopyMode = False
Rows(fl - 1 & ":" & fl + ll - 2).Select

End Sub

Sub descendre()
' ll nombre de lignes de la sélection
ll = Selection.Rows.Count
'fl première ligne de la sélection
fl = Selection.Cells(1, 1).Row

' couper la ligne suivant la sélection
Rows(fl + ll).Cut
' insérer la ligne avant la sélection et décalant les autres lignes vers le bas
Rows(fl).Insert Shift:=xlDown
Rows(fl + 1 & ":" & fl + ll).Select
End Sub

Any ideas ?

Bonjour

Pourquoi ne pas tout simplement utiliser un tableau structuré qui propose par défaut la coloration d'une ligne sur 2, ce qui supprime ta MFC (particulièrement gourmande) ?

D'autant que coder avec des listObjects facilite l’existence

Ta version semble une version Mac : à préciser dans ton profil

Waaaa mais c'est génial les tableaux structurés, je me suis fais vraiment fait chier !! Merci 78Chris !

Bon j'y suis presque ! En jouant avec les cellules verrouillées et la protection de la feuille. Il me reste un dernier petit souci. J'y tiens à cette fonction de monter / descendre les lignes car le tableau va rapidement faire plusieurs centaines de lignes (d'où le tri / filtre). C'est une sorte de petite base de données perso. Et c'est mieux si c'est lisible même après tri / filtre en arrangeant les lignes.

J'ai empêché de monter plus haut que la ligne 3 avec un simple IF comme ceci :

Sub monter()
 '--- Always UNPROTECT before VBA ---
        ActiveSheet.Unprotect
' ll nombre de lignes de la sélection
ll = Selection.Rows.Count
'fl première ligne de la sélection
fl = Selection.Cells(1, 1).Row

 If (ActiveCell.Row > 3) Then
         ' couper la ligne précédant la sélection
Rows(fl - 1).Cut
' insérer la ligne après la sélection et décalant les autres lignes vers le bas
Rows(fl + ll).Insert Shift:=xlDown
Application.CutCopyMode = False
Rows(fl - 1 & ":" & fl + ll - 2).Select

        Else
            MsgBox "Please select a row in the data range !"
            End If

'--- Always PROTECT after VBA ---
        ActiveSheet.Protect AllowFiltering:=True, AllowSorting:=True

End Sub

Par contre je suis embêté pour la descente... Admettons que je prenne une ligne au milieu du tableau, je descends je descends... Et arrivé à la dernière ligne je voudrais afficher une MsgBox indiquant qu'on ne peut pas descendre plus. Mais comment faire cela ? En effet cette fameuse dernière ligne est une variable, ça bouge en fonction de la taille du tableau justement. Dans le cas actuel, j'ai trouvé comment dire que les lignes insérées au-dessus étaient déverrouillées mais elles ne rentrent pas dans le tableau structuré (le formatage n'est pas bon). Ci-dessous le code de la macro et le fichier joint. Merci de votre aide. Je pense qu'il faudrait définir une plage de données, étant le tableau et donc définir cette fameuse dernière ligne.

Sub descendre()
 '--- Always UNPROTECT before VBA ---
        ActiveSheet.Unprotect
' ll nombre de lignes de la sélection
ll = Selection.Rows.Count
'fl première ligne de la sélection
fl = Selection.Cells(1, 1).Row

 If (ActiveCell.Row > 2) Then
' couper la ligne suivant la sélection
Rows(fl + ll).Cut
' insérer la ligne avant la sélection et décalant les autres lignes vers le bas
Rows(fl).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Rows(fl).Locked = False
Rows(fl + 1 & ":" & fl + ll).Select
 Else
            MsgBox "Please select a row in the data range !"
            End If
'--- Always PROTECT after VBA ---
        ActiveSheet.Protect AllowFiltering:=True, AllowSorting:=True
End Sub

RE

Si j'ai bien compris

Sub Monter()
'Monter les lignes de la sélection au-dessus de la ligne précédente

    With [Tableau3].ListObject.DataBodyRange
        y = Selection.Row - .Row + 1
        If y = 1 Then MsgBox "Please select a row in the data range !": Exit Sub
        Nbl = Selection.Rows.Count
        NbC = .Columns.Count
        .Range(Cells(y, 1), Cells(y + Nbl - 1, NbC)).Cut
        .Rows(y - 1).Insert Shift:=xlDown
    End With
End Sub

Sub Descendre()
'Descendre les lignes de la sélection en dessous de la ligne située en-dessous
        With [Tableau3].ListObject.DataBodyRange
        y = Selection.Row - .Row + 1
        Nbl = Selection.Rows.Count
        NbC = .Columns.Count
        .Range(Cells(y, 1), Cells(y + Nbl - 1, NbC)).Cut
        .Rows(y + Nbl + 1).Insert Shift:=xlDown
    End With
End Sub

Bonjour Chris,

Je te remercie il faut que je lise le chapitre consacré aux tableaux structurés !

J'ai gardé la macro pour monter qui fonctionne bien.

Par contre pour la descente, j'ai simplement ajouté un Select pour garder la ligne sélectionnée si on veut la descendre plusieurs fois. Mais j'ai toujours le même problème, je voudrais que si on sélectionne la dernière ligne du tableau on ait un MsgBox car pas possible de descendre plus bas.

Forcement on fait un Cut sur la ligne d'en dessous qui est non seulement verrouillée mais aussi d'un formatage différent. Ca ne me dérange pas qu'on ne puisse pas agrandir le tableau de cette façon (il y'a insérer ligne pour ça). Il faut juste qu'on puisse détecter qu'on est sur la dernière ligne du tableau et empêcher la descente.

Je vais lire le chapitre sur les tableaux structurés, peut-être vais-je y trouver ma réponse (dernière ligne dans la plage de données du tableau).

J'ai réussi :

Sub Descendre()
 '--- Always UNPROTECT before VBA ---
        ActiveSheet.Unprotect
'Descendre les lignes de la sélection en dessous de la ligne située en-dessous
       If (ActiveCell.Row = Range("Tableau3").Rows.Count + 2) Then
        MsgBox "Tu vois bien que tu es arrivé en bas tronche de cake !"
        Else

        With [Tableau3].ListObject.DataBodyRange
        y = Selection.Row - .Row + 1
        Nbl = Selection.Rows.Count
        NbC = .Columns.Count
        .Range(Cells(y, 1), Cells(y + Nbl - 1, NbC)).Cut
        .Rows(y + Nbl + 1).Insert Shift:=xlDown
        .Rows(y + Nbl).Locked = False
        .Rows(y + Nbl).Select
    End With
    '--- Always PROTECT after VBA ---
        ActiveSheet.Protect AllowFiltering:=True, AllowSorting:=True
        End If
End Sub

Vos remarques sont les bienvenues, normalement je suis arrivé quasiment à ce que je voulais faire. A part afficher le numéro de ligne sélectionnée pour le fun y reste plus grand chose à part remplir ce tableau. Un grand merci !

Bonjour

En restant sur la logique tableau sans avoir à tenir compte de sa position dans la feuille (qui peut donc évoluer sans besoin de toucher au code)

Sub Descendre()
'Descendre les lignes de la sélection d'une ligne en-dessous
    With [Tableau3].ListObject.DataBodyRange
        y = Selection.Row - .Row + 1
        Nbl = Selection.Rows.Count
        If y + Nbl - 1 = .Rows.Count Then MsgBox "Please select a row in the data range !": Exit Sub
        NbC = .Columns.Count
        .Range(Cells(y, 1), Cells(y + Nbl - 1, NbC)).Cut
        .Rows(y + Nbl + 1).Insert Shift:=xlDown
    End With
End Sub

A noter que l'on peut autoriser VBA à travailler sur une feuille protégée : voir l'aide de Protect

D'accord je vais essayer ça.

Si je fais du tri, les macro descendre / monter ne fonctionnent plus. Une idée ? Effectivement les numéros de lignes ne correspondent plus au tableau général. Aie aie c'est compliqué de faire quelque chose qui fonctionne dans tous les cas ^^

Bonjour

Bizarre : pour tester mon code j'ai trié x fois le tableau sans souci et je viens de tester à nouveau sans souci.

C'est parce que je persiste à vouloir utiliser ma macro... J'ai du mal à comprendre avec le code de tableau structuré mais je vais m'y mettre, faut que j'essaie.

Ah oui c'est étonnant. Voici la macro que j'ai légèrement modifiée mais dès que j'ai fait un tri j'ai le droit à :

"La méthode Insert de la classe Range a échoué".

Sub Descendre()
 '--- Always UNPROTECT before VBA ---
        ActiveSheet.Unprotect
'Descendre les lignes de la sélection d'une ligne en-dessous
    With [Tableau3].ListObject.DataBodyRange
        y = Selection.Row - .Row + 1
        Nbl = Selection.Rows.Count
        If y + Nbl - 1 = .Rows.Count Then
        MsgBox "Please select a row in the data range !"
        ElseIf ActiveCell.Row = 2 Then
        MsgBox "Tu le fais exprès ? Tu vas pas descendre l'entête !"
    Else
        NbC = .Columns.Count
        .Range(Cells(y, 1), Cells(y + Nbl - 1, NbC)).Cut
        .Rows(y + Nbl + 1).Insert Shift:=xlDown
        .Rows(y + Nbl).Locked = False
        .Rows(y + Nbl).Select
        End If
    End With
         '--- Always PROTECT after VBA ---
        ActiveSheet.Protect AllowFiltering:=True, AllowSorting:=True
End Sub

Il bug sur le .insert une fois qu'il y'a une plage avec tri. Raa là je botte en touche...

.Rows(y + Nbl + 1).Insert Shift:=xlDow

RE

Ne confondrais-tu pas tri et filtre ?

Tout à fait... mes excuses :)

Re

Effectivement, je ne pense pas que l'on puisse déplacer si les lignes sont masquées par le filtre car manuellement ce ne pas possible