VBA - Collage de ligne selon condition - Problème de boucle

Le 18/06/2015 à 15:06

Bonjour à tous,

Je viens à vous car j'ai réalisé une macro VBA suite à différentes trouvailles sur internet.

Le but de cette macro est de copier/coller un numéro de référence selon une condition.

Un premier onglet "Approved PO" liste différents matériels et leurs statut de réception.

Un second onglet " Réceipt material" liste les différents matériels en stock.

Mon objectif :

Copier tous les "PO number" de l'onglet "Approved PO" à l'onglet "Receipt material" qui répondent à cette condition :

Approved PO : Colonne I : "Complete". Pour cela j'ai créer un bouton (Macro copie) dans l'onglet "Receipt material"

La macro VBA que j'ai réalisé fonctionne. Cependant la recherche ne se fait qu'une fois, elle ne boucle pas. Une fois qu'elle a trouvé une première ligne "Complete" elle n'en copie pas d'autre, bien qu'il en existe..

J'espère donc pouvoir obtenir, auprès de vous, une solution à cette problématique sur laquelle je bloque complètement car pour moi le Loop est placé au bon endroit.

Je vous remercie d'avance et vous souhaite à tous une très agréable journée.

Cordialement,

Raphaël

36dashboard-po.xlsx (33.08 Ko)
Le 18/06/2015 à 16:01

Hello,

Avec ce code:

Option Explicit

Sub copie_PO()
Dim i, ligne_vide As Integer

'Boucle toutes les lignes du tableau approved
For i = 5 To Sheets("Approved PO").Cells(4, 2).End(xlDown).Row
    If Sheets("Approved PO").Cells(i, 9).Value = "Complete" Then
    'Détermination de la ligne vide dans laquelle sera faite la copie
    ligne_vide = Sheets("Receipt material").Cells(200000, 2).End(xlUp).Row + 1
    'Copie des informations
    Sheets("Receipt material").Cells(ligne_vide, 2).Value = Sheets("Approved PO").Cells(i, 2).Value
    Sheets("Receipt material").Cells(ligne_vide, 3).Value = Sheets("Approved PO").Cells(i, 4).Value
    Sheets("Receipt material").Cells(ligne_vide, 4).Value = Sheets("Approved PO").Cells(i, 5).Value
    End If
Next i

End Sub
Le 18/06/2015 à 16:53

Merci 1000 fois pour ta spontanéité. Tu as résolu mon soucis et je t'en remercie fortement !

Passes une très bonne journée !

J'ai pu tester ta macro mais je n'avais même pas pensé à la gestion des doublons .. idiot que je suis..

Est-ce difficile à réaliser ? Car à chaque clics je ré-importe les mêmes lignes.

Merci d'avance si tu peux me venir en aide à ce niveau là.

Le 18/06/2015 à 21:04

Jme doutais bien. Tu veux supprimer les complete de la première feuille ou juste éviter de réimporter les lignes déjà copiées?

Le 19/06/2015 à 00:20

Je veux juste éviter de réimporter les mêmes lignes en fait.

Le 19/06/2015 à 16:17

Teste ça voir

Option Explicit

Sub copie_PO()
Dim i, ligne_vide As Integer
Dim c As Range

'Boucle toutes les lignes du tableau approved
For i = 5 To Sheets("Approved PO").Cells(4, 2).End(xlDown).Row
    If Sheets("Approved PO").Cells(i, 9).Value = "Complete" Then
    Set c = Sheets("Receipt material").Columns(2).Find (what:= Sheets("Approved PO").Cells(i, 2).Value, LookAt:=xlWhole)
    If c nothing Then
   'Détermination de la ligne vide dans laquelle sera faite la copie
   ligne_vide = Sheets("Receipt material").Cells(200000, 2).End(xlUp).Row + 1
    'Copie des informations
   Sheets("Receipt material").Cells(ligne_vide, 2).Value = Sheets("Approved PO").Cells(i, 2).Value
    Sheets("Receipt material").Cells(ligne_vide, 3).Value = Sheets("Approved PO").Cells(i, 4).Value
    Sheets("Receipt material").Cells(ligne_vide, 4).Value = Sheets("Approved PO").Cells(i, 5).Value
    End If
    End If
Next i

End Sub
Le 22/06/2015 à 13:59

Bonjour,

Merci pour ta réponse. Néanmoins il y a un problème de syntaxe lorsque je colle ces lignes. Au niveau du "If c nothing then". Dois-je rajouter une condition ?

Merci beaucoup

Le 22/06/2015 à 21:31

Ah sorry j'ai oublié un is.

c'est "If c is nothing"

Le reste devrait fonctionner

Option Explicit

Sub copie_PO()
Dim i, ligne_vide As Integer
Dim c As Range

'Boucle toutes les lignes du tableau approved
For i = 6 To Sheets("Approved PO").Cells(4, 2).End(xlDown).Row
    If Sheets("Approved PO").Cells(i, 9).Value = "Complete" Then
    Set c = Sheets("Receipt material").Columns(2).Find (what:= Sheets("Approved PO").Cells(i, 2).Value, LookAt:=xlWhole)
    If c is nothing Then
   'Détermination de la ligne vide dans laquelle sera faite la copie
  ligne_vide = Sheets("Receipt material").Cells(200000, 2).End(xlUp).Row + 1
    'Copie des informations
  Sheets("Receipt material").Cells(ligne_vide, 2).Value = Sheets("Approved PO").Cells(i, 2).Value
    Sheets("Receipt material").Cells(ligne_vide, 3).Value = Sheets("Approved PO").Cells(i, 4).Value
    Sheets("Receipt material").Cells(ligne_vide, 4).Value = Sheets("Approved PO").Cells(i, 5).Value
    End If
    End If
Next i

End Sub
Le 07/07/2015 à 15:24

Bonjour à tous,

Je ne comprends pas.. cette dernière macro fonctionnait très bien (Copie_PO)... et depuis aujourd'hui plus rien.. j'ai beau cliquer sur le bouton sur lequel j'ai affecté cette macro mais plus rien... Incompréhensible.. Il en est de même pour le reste de mes macros et pourtant les macros sont bien activées..

Savez-vous si un paramètre peut intervenir dans ce dysfonctionnement soudain ?

Merci d'avance,

Raphaël

21dashboard-po-v2.xlsm (274.29 Ko)
Le 07/07/2015 à 17:20

Tu as inséré des lignes dans ta feuille "Approved PO" entre les lignes 1 et 4?

Avec ce code tu devrais éviter les erreurs en cas d'insertion de ligne d'en-tête.

Sub copie_PO()

Dim i, ligne_vide As Integer
Dim c As Range

'Boucle toutes les lignes du tableau approved
For i = 6 To Sheets("Approved PO").Cells(200000, 2).End(xlUp).Row
    If Sheets("Approved PO").Cells(i, 10).Value = "Complete" Then
    Set c = Sheets("Receipt material (SAP)").Columns(1).Find(what:=Sheets("Approved PO").Cells(i, 3).Value, LookAt:=xlWhole)
       If c Is Nothing Then
        'Détermination de la ligne vide dans laquelle sera faite la copie
        ligne_vide = Sheets("Receipt material (SAP)").Cells(200000, 1).End(xlUp).Row + 1
        'Copie des informations
        Sheets("Receipt material (SAP)").Cells(ligne_vide, 1).Value = Sheets("Approved PO").Cells(i, 3).Value
        Sheets("Receipt material (SAP)").Cells(ligne_vide, 2).Value = Sheets("Approved PO").Cells(i, 4).Value
        Sheets("Receipt material (SAP)").Cells(ligne_vide, 3).Value = Sheets("Approved PO").Cells(i, 5).Value
        Sheets("Receipt material (SAP)").Cells(ligne_vide, 4).Value = Sheets("Approved PO").Cells(i, 7).Value
        Sheets("Receipt material (SAP)").Cells(ligne_vide, 5).Value = Sheets("Approved PO").Cells(i, 6).Value
        Sheets("Receipt material (SAP)").Cells(ligne_vide, 8).Value = Sheets("Approved PO").Cells(i, 9).Value
       End If
    End If
Next i

End Sub

Et pour l'autre:

Sub copie_PO2()

Dim a, b, ligne_vide As Integer
Dim c, d As Range

'Boucle toutes les lignes du tableau approved
For a = 6 To Sheets("Receipt material (SAP)").Cells(200000, 2).End(xlUp).Row
    If Sheets("Receipt material (SAP)").Cells(a, 7).Value = "Laptop" Then
    Set c = Sheets("Receipt material (SD)").Columns(1).Find(what:=Sheets("Receipt material (SAP)").Cells(a, 1).Value, LookAt:=xlWhole)
        If c Is Nothing Then
        'Détermination de la ligne vide dans laquelle sera faite la copie
        ligne_vide = Sheets("Receipt material (SD)").Cells(200000, 1).End(xlUp).Row + 1
        'Copie des informations
        Sheets("Receipt material (SD)").Cells(ligne_vide, 1).Value = Sheets("Receipt material (SAP)").Cells(a, 1).Value
        Sheets("Receipt material (SD)").Cells(ligne_vide, 2).Value = Sheets("Receipt material (SAP)").Cells(a, 3).Value
        Sheets("Receipt material (SD)").Cells(ligne_vide, 3).Value = Sheets("Receipt material (SAP)").Cells(a, 5).Value
        Sheets("Receipt material (SD)").Cells(ligne_vide, 4).Value = Sheets("Receipt material (SAP)").Cells(a, 6).Value
        Sheets("Receipt material (SD)").Cells(ligne_vide, 5).Value = Sheets("Receipt material (SAP)").Cells(a, 8).Value
        End If
    End If
      Next a
For b = 6 To Sheets("Receipt material (SAP)").Cells(200000, 2).End(xlUp).Row
    If Sheets("Receipt material (SAP)").Cells(b, 7).Value = "Laptop equipment" Then
    Set d = Sheets("Receipt material (SD)").Columns(1).Find(what:=Sheets("Receipt material (SAP)").Cells(b, 1).Value, LookAt:=xlWhole)
        If d Is Nothing Then
        'Détermination de la ligne vide dans laquelle sera faite la copie
        ligne_vide = Sheets("Receipt material (SD)").Cells(200000, 1).End(xlUp).Row + 1
        'Copie des informations
        Sheets("Receipt material (SD)").Cells(ligne_vide, 1).Value = Sheets("Receipt material (SAP)").Cells(b, 1).Value
        Sheets("Receipt material (SD)").Cells(ligne_vide, 2).Value = Sheets("Receipt material (SAP)").Cells(b, 3).Value
        Sheets("Receipt material (SD)").Cells(ligne_vide, 3).Value = Sheets("Receipt material (SAP)").Cells(b, 5).Value
        Sheets("Receipt material (SD)").Cells(ligne_vide, 4).Value = Sheets("Receipt material (SAP)").Cells(b, 6).Value
        Sheets("Receipt material (SD)").Cells(ligne_vide, 5).Value = Sheets("Receipt material (SAP)").Cells(b, 8).Value
        End If
    End If
Next b

End Sub
Rechercher des sujets similaires à "vba collage ligne condition probleme boucle"