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.

3classeur1.xlsx (17.29 Ko)

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 :

6loureed.xlsm (35.91 Ko)

@ 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 ^^

Rechercher des sujets similaires à "deplacer donnees"