Déplacer une ligne sur une autre feuille avec des criteres

Le 19/01/2015 à 18:04

Bonjour à tous,

je vous expose mon problème, mon fichier est un tableau récapitulatif des prestations faites dans le mois et il contient plusieurs informations dont l'identifiant, le nom de la prestation et le prix de vente

le but de ma démarche est de déplacer certaines lignes dans un autre onglets du fichier en fonction de cet énoncé :

pour un même identifiant si la prestation "PVN1" ou "PVN4" existe alors les prestations "confection de plaques", "pose de plaques" ou "mise en carburant" sont à déplacer dans l'autre onglet sinon on les laisses

ex :

EW663769 PVN1

EW663769 mise en carburant

ET452710 mise en carburant

seul la 2nde ligne est à déplacer

J'ai mis un fichier en pièce jointe

j'espère avoir été clair dans ma démarche

merci d'avance pour votre aides à tous

57traitement-pvn.xlsx (234.19 Ko)
Le 19/01/2015 à 20:49
nanaki78 a écrit :

Bonjour à tous,

je vous expose mon problème, mon fichier est un tableau récapitulatif des prestations faites dans le mois et il contient plusieurs informations dont l'identifiant, le nom de la prestation et le prix de vente

le but de ma démarche est de déplacer certaines lignes dans un autre onglets du fichier en fonction de cet énoncé :

pour un même identifiant si la prestation "PVN1" ou "PVN4" existe alors les prestations "confection de plaques", "pose de plaques" ou "mise en carburant" sont à déplacer dans l'autre onglet sinon on les laisses

ex :

EW663769 PVN1

EW663769 mise en carburant

ET452710 mise en carburant

seul la 2nde ligne est à déplacer

J'ai mis un fichier en pièce jointe

j'espère avoir été clair dans ma démarche

merci d'avance pour votre aides à tous

Bonsoir

A tester

Private Sub Macro1()
Feuil_source = "Feuil1" ' Feuille ou se trouve toutes les données
Feuil_separation = "Feuil2" 'Feuille ou doivent arriver les exceptions choisies
Dim ligne_feuil_1 As Integer
Dim ligne_feuil_2 As Integer
Sheets("Feuil1").Activate
    For i = 10000 To 3 Step -1
    Set c = Sheets(Feuil_source).Range("D" & i)
        If c <> "" And (c = "Confection de 2 plaques" Or c = "pose de plaques" Or c = "Mise en carburant") Then 'Ici sont renseignées les exceptions
        'si besoin en ajouter Or c = "Exception" or c="Exception"
        Sheets(Feuil_source).Rows(i).EntireRow.Copy
        Sheets(Feuil_separation).Select
        nextrow = (Sheets(Feuil_separation).Range("A" & Rows.Count).End(xlUp).Row + 1)
        Sheets(Feuil_separation).Rows(nextrow).EntireRow.Select
        ActiveSheet.Paste
        Sheets(Feuil_source).Rows(i).EntireRow.Delete
        End If
    Next

Sheets(Feuil_source).Activate

MsgBox "Tri terminé"

End Sub

Cdt,

Le 20/01/2015 à 12:20

Merci poru ce message qui m'intéresse particulièrement. Cependant, où est-ce que je mets ce bout de code ? Dans un bouton via une macro ? Dans un module ?

Est-ce qu'on peut faire cette opération via un userform ?

Seb

Le 20/01/2015 à 12:49
sebastieng25 a écrit :

Merci poru ce message qui m'intéresse particulièrement. Cependant, où est-ce que je mets ce bout de code ? Dans un bouton via une macro ? Dans un module ?

Est-ce qu'on peut faire cette opération via un userform ?

Seb

Tu crees un bouton si tu veux tu y affectes ce code

Cdt

Le 20/01/2015 à 17:55

Bonjour,

merci pour votre aide et votre temps cela résout une partie de mon problème

en effet avec votre code toutes les prestations "confections de plaques" et autres sont déplacées sur la seconde feuille sans prendre en compte les critères d'identifiants et PVN1

mon but est que pour un identifiant si la prestation PVN1 existe de déplacer les prestations "confections..." ou autre de ce meme identifiant dans la seconde feuille, si la prestation PVN1 n'existe pas pour l'identifiant alors on garde sur la feuille 1 les "confections..." et autres de l'identifiant en question

je sais pas si je suis clair dans mes propos, désolé si cela est le cas.

merci d'avance

Le 20/01/2015 à 21:17
nanaki78 a écrit :

Bonjour,

merci pour votre aide et votre temps cela résout une partie de mon problème

en effet avec votre code toutes les prestations "confections de plaques" et autres sont déplacées sur la seconde feuille sans prendre en compte les critères d'identifiants et PVN1

mon but est que pour un identifiant si la prestation PVN1 existe de déplacer les prestations "confections..." ou autre de ce meme identifiant dans la seconde feuille, si la prestation PVN1 n'existe pas pour l'identifiant alors on garde sur la feuille 1 les "confections..." et autres de l'identifiant en question

je sais pas si je suis clair dans mes propos, désolé si cela est le cas.

merci d'avance

Bonsoir

Voici le code :

Private Sub Macro1()
Feuil_source = "Feuil1" ' Feuille ou se trouve toutes les données
Feuil_separation = "Feuil2" 'Feuille ou doivent arriver les exceptions choisies
Dim ligne_feuil_1 As Integer
Dim ligne_feuil_2 As Integer
Sheets("Feuil1").Activate
    For i = 10000 To 3 Step -1
    Set c = Sheets(Feuil_source).Range("D" & i)
        If c <> "" And (c = "Confection de 2 plaques" Or c = "pose de plaques" Or c = "Mise en carburant") Then 'Ici sont renseignées les exceptions
       'si besoin en ajouter Or c = "Exception" or c="Exception"

       identifiant = c.Offset(0, -3)
       Call existe_pvn1(identifiant, retour)
       If retour = "ok" Then
       Sheets(Feuil_source).Rows(i).EntireRow.Copy
        Sheets(Feuil_separation).Select
        nextrow = (Sheets(Feuil_separation).Range("A" & Rows.Count).End(xlUp).Row + 1)
        Sheets(Feuil_separation).Rows(nextrow).EntireRow.Select
        ActiveSheet.Paste
        Sheets(Feuil_source).Rows(i).EntireRow.Delete
        End If
        End If
    Next

Sheets(Feuil_source).Activate

MsgBox "Tri terminé"

End Sub

Function existe_pvn1(identifiant, retour)

For Each c In Range("A3:A10000")
If c <> "" And c.Offset(0, 3) = "PVN1" And c = identifiant Then
retour = "ok"
GoTo fin
End If
Next
retour = "nok"
fin:
End Function

Je fais appel a une fonction lorsque je suis dans le cas de :

  • c = "Confection de 2 plaques"
  • c = "pose de plaques"
  • c = "Mise en carburant"

Dans ce cas ma fonction est appelé en lui envoyant l'identifiant de la ligne concernée.

Le système va donc parcourir tout le fichier et si un meme identifiant a une ligne en PVN1 alors retour = ok

Si retour = ok alors le transfère ma ligne

Cdt,

Le 21/01/2015 à 18:28

bonsoir ti_chou_3

merci encore pour le temps que vous prenez à m'aider à résoudre mon problème

Sur le principe la macro fonctionne, le seul probleme c'est que j'ai qu'une seule ligne qui est déplacé a chaque fois que je lance la macro, ce qui fait qu'il faudrait que je lance la macro plusieurs fois pour que toutes les lignes soient déplacées.

Est-il possible de déplacer les lignes d'un coups ?

merci d'avance

Le 21/01/2015 à 19:01
nanaki78 a écrit :

bonsoir ti_chou_3

merci encore pour le temps que vous prenez à m'aider à résoudre mon problème

Sur le principe la macro fonctionne, le seul probleme c'est que j'ai qu'une seule ligne qui est déplacé a chaque fois que je lance la macro, ce qui fait qu'il faudrait que je lance la macro plusieurs fois pour que toutes les lignes soient déplacées.

Est-il possible de déplacer les lignes d'un coups ?

merci d'avance

bonsoir

je vais regarder

Le 21/01/2015 à 19:27
nanaki78 a écrit :

bonsoir ti_chou_3

merci encore pour le temps que vous prenez à m'aider à résoudre mon problème

Sur le principe la macro fonctionne, le seul probleme c'est que j'ai qu'une seule ligne qui est déplacé a chaque fois que je lance la macro, ce qui fait qu'il faudrait que je lance la macro plusieurs fois pour que toutes les lignes soient déplacées.

Est-il possible de déplacer les lignes d'un coups ?

merci d'avance

Voici le code MAJ

Private Sub Macro1()
Feuil_source = "Feuil1" ' Feuille ou se trouve toutes les données
Feuil_separation = "Feuil2" 'Feuille ou doivent arriver les exceptions choisies
Dim ligne_feuil_1 As Integer
Dim ligne_feuil_2 As Integer
Sheets("Feuil1").Activate
    For i = 10000 To 3 Step -1
    Set c = Sheets(Feuil_source).Range("D" & i)
        If c <> "" And (c = "Confection de 2 plaques" Or c = "pose de plaques" Or c = "Mise en carburant") Then 'Ici sont renseignées les exceptions
      'si besoin en ajouter Or c = "Exception" or c="Exception"

       identifiant = c.Offset(0, -3)
       Call existe_pvn1(identifiant, retour)
       If retour = "ok" Then
       Sheets(Feuil_source).Rows(i).EntireRow.Copy
        Sheets(Feuil_separation).Select
        nextrow = (Sheets(Feuil_separation).Range("A" & Rows.Count).End(xlUp).Row + 1)
        Sheets(Feuil_separation).Rows(nextrow).EntireRow.Select
        ActiveSheet.Paste
        Sheets(Feuil_source).Rows(i).EntireRow.Delete
        Sheets(Feuil_source).Activate
        End If
        End If
    Next

Sheets(Feuil_source).Activate

MsgBox "Tri terminé"

End Sub

Function existe_pvn1(identifiant, retour)
Feuil_source = "Feuil1" ' Feuille ou se trouve toutes les données
For Each d In Sheets(Feuil_source).Range("A3:A10000")
If d <> "" And d.Offset(0, 3) = "PVN1" And d= identifiant Then
retour = "ok"
GoTo fin
End If
Next
retour = "nok"
fin:
End Function
Le 22/01/2015 à 15:37

bonjour,

merci pour votre aide le code fonctionne à merveille

merci encore pour votre temps

cordialement

Rechercher des sujets similaires à "deplacer ligne feuille criteres"