XL 2016 Transfert ligne avec Liste Validation des données

[Scorpio]

Bonjour à tous,
J'ai un petit soucis dans mon classeur, dont je ne suis pas l'hauteur du code VBA, mais, j'aimerais s'il vous plaît, et, si possible, un petit coup de pouce car lorsque je transfert une ligne, la liste de validation des données se transfert aussi.
Et j'aimerais pas.
Pour transférer une ligne, clic sur la colonne "A", chiffre en rouge, et bouton transfert
Merci A ++++

 

[job75]

Bonsoir Scorpio,

Mettre en fin de macro :

Sheets("Feuil2").Range("B:C").Validation.Delete

A+

 

[Scorpio]

Bonjour Job 75,
Super, merci beaucoup, le fonctionnement Tiptop

Dite Job75, lorsque je transfert la ligne, j'ai aussi une formule en colonne "G".
J'aimerais transférer que la valeur et pas la formule.
Est-ce que ceci correspond?
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks

:=False, Transpose:=False​

A+++

 

[job75]

Bonjour Scorpio,

Quand c'est possible il vaut mieux éviter le collage spécial en VBA.

Le problème de votre code est que la cellule dest était écrasée par le couper-coller.

Mais en utilisant à la place la cellule dercel il n'y a plus de problème de repérage :

            If cel.Font.ColorIndex = 3 Then    'rouge
                Set dercel = Sheets("Feuil2").Range("A65536").End(xlUp)
                cel.EntireRow.Cut dercel(2) 'coupe et colle la ligne
                dercel(2, 2).Resize(, 2).Validation.Delete 'supprime les listes de validation en colonnes B et C
                dercel(2, 7) = dercel(2, 7).Value 'supprime la formule en colonne G
            End If

Les listes de validation et la formule sont supprimées en même temps.

Nota : dans la formule en colonne G j'ai remplacé l'espace par le caractère insécable de code 160.

Cela évite en 2ème feuille qu'Excel indique que le nombre est au format texte.

Et évite qu'une revalidation convertisse le texte en nombre...

Fichier corrigé joint.

A+

 

[Scorpio]

Re bonjour Job75,
Ben je vous remercie beaucoup Job75, super.
Malheureusement pour moi, ma compréhension dans tous ces codes n'est pas la votre, certain truc ca vas, mais voilà pas plus.
Merci encore pour tous, vous m'avez bien aidé.
Bonne journée
A+++

 

[job75]

Re,

Sachez Scorpio que s'il y avait un grand nombre de lignes à transférer d'un coup il faudrait être beaucoup plus "professionnel".

Voici donc le code optimisé :

'le code de cette fonction doit toujours être placé dans un module standard
Function Rouge(c As Range) As Boolean
Rouge = c.Font.ColorIndex = 3
End Function

Sub DepLigneCouleur()
    Dim dest As Range 'déclare la variable dest (DESTination)
    Dim n As Long     'déclare la variable n

    Application.ScreenUpdating = False 'masque les changements à l'écran
    Set dest = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp)(2)

    With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
        With .Range("A2", .Range("A" & .Rows.Count).End(xlUp)) '1ère colonne
            If .Row = 1 Then Exit Sub
            .Columns(8) = "=1/Rouge(A2)" 'formule utilisant la fonction en colonne auxiliaire H
            .Columns(8) = .Columns(8).Value 'supprime les formules
            .EntireRow.Sort .Columns(8), xlDescending, Header:=xlNo 'tri pour regrouper et accélérer
            n = Application.Count(.Columns(8))
            If n Then
                With .Columns(8).SpecialCells(xlCellTypeConstants, 1).EntireRow
                    .Resize(, 7).Copy dest 'copie les colonnes A:G
                    .Delete
                End With
                dest(1, 2).Resize(n, 2).Validation.Delete 'supprime les listes de validation en colonnes B et C
                dest(1, 7).Resize(n) = dest(1, 7).Resize(n).Value 'supprime les formules en colonne G
            End If
            .Columns(8).ClearContents 'RAZ de la colonne H auxiliaire
        End With
    End With
   
    dest.Parent.Cells.Sort dest.Parent.Cells(1), xlAscending, Header:=xlYes 'tri de la 2ème feuille
    Application.Goto dest.Parent.Range("A1")
    Application.Goto Sheets("Feuil1").Range("B1")
   
End Sub

Fichier (2).

J'ai testé en recopiant en 1ère feuille les lignes 2:5 jusqu'à la ligne 40001 (10000 lignes à transférer).

La macro s'exécute chez moi en 2,1 secondes.

Cette rapidité est due au fait qu'il n'y a aucune boucle dans la macro.

A+

 

[Scorpio]

Re Job 75,
Je vous remercie de toutes ces explications.
Mais que veux dire le "1" s'affichant en colonne "H"

 

[job75]

Re,

J'avais mis Header:=xlYes pour le 1er tri, il faut en fait Header:=xlNo, je viens de corriger le post #6.

Mais que veux dire le "1" s'affichant en colonne "H"

La formule =1/Rouge(A2) met des 1 et des #DIV/0! en colonne H.

Les 1 déterminent les lignes à transférer (police rouge en colonne A).

A+

 

[Scorpio]

Re,
Donc le "1" se retrouve bien dans la feuille 2, lorsque la ligne à été transférée ?
Ce qui est le cas chez moi.

 

[job75]

Re,

Ah oui bien sûr il faut limiter la copie aux colonnes A:G, j'ai de nouveau corrigé le post #6.

A+

 

[Scorpio]

Re,
Donc, le "1" ne s'affiche plus, ni sur feuil1 ni sur feuil2

 

[job75]

Re,

Les "1" sont regroupés en bas du tableau en Feuil1 et leurs lignes supprimées après copie.

A+

 

[Scorpio]

Re,
OK, merci beaucoup pour tous Job75
Et à plus