Deplacer des données

Bonjour

Je voudrais déplacer les lignes ou la désignation livré "oui" est mentionné automatiquement vers la feuille Livrée.

Je vous joins le tableur.

Bonjour toutes et tous

@tester et à améliorer

ci-joint

Option Explicit

Sub test()

      ' déclarations variables
    Dim x As Integer
Dim DernLigne As Long
  Dim n, ident
On Error Resume Next
On Error GoTo plouf
'x = 1

DernLigne = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
For n = 2 To DernLigne
ident = Sheets("Feuil1").Range("N" & n)
If Right(ident, 13) = "oui" Then
x = x + 1
With Sheets("Livrée")
.Range("A" & x) = Sheets("Feuil1").Range("A" & n)
.Range("B" & x) = Sheets("Feuil1").Range("B" & n)
.Range("C" & x) = Sheets("Feuil1").Range("C" & n)
.Range("D" & x) = Sheets("Feuil1").Range("D" & n)
.Range("E" & x) = Sheets("Feuil1").Range("E" & n)
.Range("F" & x) = Sheets("Feuil1").Range("F" & n)
.Range("G" & x) = Sheets("Feuil1").Range("G" & n)
.Range("H" & x) = Sheets("Feuil1").Range("H" & n)
.Range("I" & x) = Sheets("Feuil1").Range("I" & n)
.Range("J" & x) = Sheets("Feuil1").Range("J" & n)
.Range("K" & x) = Sheets("Feuil1").Range("K" & n)
.Range("L" & x) = Sheets("Feuil1").Range("L" & n)
.Range("M" & x) = Sheets("Feuil1").Range("M" & n)
'.Range("N" & x) = Sheets("Feuil1").Range("N" & n)
End With
End If
Next
plouf:    Exit Sub
End Sub

crdlt,

André

Bonsoir, Andre13,

une autre proposition par l'ajout d'un tableau structuré sur la feuille 2 et suppression des lignes transférées :
le fichier :

@ bientôt

LouReeD

Re,

Merci LouReed

oups, j'ai une erreur 438 au lancement de la macro LouReed (bouton Allons-y de la feuil1)

' on tri la colonne Livré afin de mettre les "Oyi" en tête de tableau
ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau13").Sort.SortFields. _ Add2 Key:=Range("Tableau13[[#All],[Livrée]]"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal

merci

Bonjour,

étrange, mais il est vrai que je ne maitrise pas les filtres et compagnie en VBA !
Pour cela je passe toujours par l'enregistreur...
Essayez de remplacer Add2 par Add ...

@ bientôt

LouReeD

Re,

bien vu ^^s'était bien cela les Add (Add2 remplacer par Add tout simplement et cela deux fois dans la macro Loureed)^

Sub LouReeD()
    Application.ScreenUpdating = False
    Dim I, J, K
    ' on efface les tris
    ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau13").Sort.SortFields. _
        Clear
    ' on tri la colonne Livré afin de mettre les "Oyi" en tête de tableau
    ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau13").Sort.SortFields. _
        Add Key:=Range("Tableau13[[#All],[Livrée]]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau13").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ' on compte le nombre de Oui = cellule non vide en colonne N
    With ActiveSheet.ListObjects(1).DataBodyRange
        I = 1
        Do
            If .Cells(I, 14) = "" Then Exit Do
            I = I + 1
        Loop
        If I = 1 Then Exit Sub Else I = I - 1
        ' on copie les lignes
        .Cells(1, 1).Resize(I, 14).Copy
        ' on recherche la dernière ligne du tableau de sauvegarde
        K = Sheets("Feuil2").ListObjects(1).ListRows.Count
        If K = 0 Then K = 2 Else K = K + 2
        ' on colle les données
        Sheets("Feuil2").Range("A" & K).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
    ' on efface les lignes du tableau source
    For J = 1 To I
        ActiveSheet.ListObjects(1).ListRows(1).Delete
    Next J
    Application.CutCopyMode = False
    ' on retri le tableau par date de commande
    ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau13").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau13").Sort.SortFields. _
        Add Key:=Range("Tableau13[[#All],[Date Commande]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau13").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

merci @toi ^^