VBA rechercher + copier/coller

[grosquick59]

Bonjour,
je suis débutant en VBA et je bloque toujours sur une macro de copier/coller.
Après avoir parcouru les forum je ne trouve pas la solution à mon problème. Je mets un fichier en pièce jointe pour plus de compréhension.
Mon projet porte sur une gestion documentaire.

Feuilles concernées
ws1 = Sheets("ENREGISTREMENT")
ws2 = Sheets("Liste_documentation")

Macro concernée = VALIDATIONDOCUMENTAIRE

Mon code fonctionne mais que si je cite une ligne précise.

OBJECTIF :
La demande de chaque utilisateur est transmise sur la feuille ws1 (ENREGISTREMENT).
Je dois ensuite pour chaque demande copier/coller la ligne dans la feuille ws2 (Liste_documentation).
Condition : dans la colonne A il doit être indiqué DIFFUSION.

Exemple :
Si A15 = DIFFUSION alors
chercher dans ws2 si le code en D15 existe. Si oui écraser la ligne avec les données. Si non alors copier/coller les données sur une ligne vierge.

J'espère que je suis assez compréhensible.
merci d'avance pour votre aide. Voici mon début de code (sans la condition)

Sub VALIDATIONDOCUMENTAIRE2()

'a/Definir les variables et fonctions puis rechercher valeur dans la liste
        
    Dim Code As String, LigF As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Sheets("ENREGISTREMENT")
    Set ws2 = Sheets("Liste_documentation")
    
    'b/macro pour diffusion/reconduction

    ' Mémoriser le code du document (colonne D)
    With ws1
    Code = Range("B15") & Format(Range("C15"), "000")
     End With
    ' Avec la feuille
    With ws2
      On Error Resume Next
      LigF = 0  ' Initialiser la ligne trouvée à ZERO
      ' Rechercher dans la colonne D le code correspondant
      LigF = .Columns("D:D").Find(What:=Code, LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Row
      If LigF <> 0 Then
        'inscrire dans la feuille la valeur de l'indice
        .Cells(LigF, "D") = ws1.Range("D15")
        .Cells(LigF, "E") = ws1.Range("E15")
        .Cells(LigF, "F") = ws1.Range("F15")
        .Cells(LigF, "G") = ws1.Range("G15")
        .Cells(LigF, "I") = ws1.Range("I15")

      End If
      On Error GoTo 0
    End With

grosquick59

 

[WUTED]

Re : VBA rechercher + copier/coller

Bonjour grosquick59,

Voilà un essai de macro qui semble correspondre à ce que tu veux faire :

Sub VALIDATIONDOCUMENTAIRE()
    Dim Code As String, LigF As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Sheets("ENREGISTREMENT")
    Set ws2 = Sheets("Liste_documentation")

    For i = 15 To ws1.Range("A65536").End(xlUp).Row
        If ws1.Range("A" & i).Value = "DIFFUSION" Then
            Code = ws1.Range("B" & i) & Format(ws1.Range("C" & i), "000")
            LigF = 0
            LigF = ws2.Columns("D:D").Find(What:=Code, LookIn:=xlValues, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Row
            If LigF = 0 Then
                LigF = ws2.Range("A65536").End(xlUp).Row + 1
            End If
            ws2.Cells(LigF, "D").Value = ws1.Range("D15").Value
            ws2.Cells(LigF, "E").Value = ws1.Range("E15").Value
            ws2.Cells(LigF, "F").Value = ws1.Range("F15").Value
            ws2.Cells(LigF, "G").Value = ws1.Range("G15").Value
            ws2.Cells(LigF, "I").Value = ws1.Range("I15").Value
        End If
    Next i
End Sub

Bonne journée.

 

[grosquick59]

Re : VBA rechercher + copier/coller

Merci WUTED
La macro fonctionne lorsque le code existe dans la feuille ws2 (liste documentation). Par contre est-il possible de faire en sorte que la ligne soit créée lorsque le code n'existe pas dans ws2 ?

Exemple : AQ-PG-027 : le code est inexistant dans la feuille ws2.

 

[WUTED]

Re : VBA rechercher + copier/coller

Re,

Normalement, si LigF = 0 aprés la recherche et donc, qu'aucun code n'a été trouvé, je met dans la variable LigF le numéro de la dernière ligne non vide + 1 et je copie la ligne à cet emplacement.

EDIT : je viens de voir que j'ai oublié de modifier du code dans ta procédure de base, quand je recopie la ligne, faut modifier les "D15" etc par "D" & i etc.

 

[grosquick59]

Re : VBA rechercher + copier/coller

Oui pourtant je vois bien la ligne mais j'ai un message d'erreur "variable non définie" sur la ligne :

            LigF = ws2.Columns("D:D").Find(What:=Code, LookIn:=xlValues, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Row

 

[grosquick59]

Re : VBA rechercher + copier/coller

Oui pourtant je vois bien la ligne mais j'ai un message d'erreur "variable non définie" sur la ligne :

            LigF = ws2.Columns("D:D").Find(What:=Code, LookIn:=xlValues, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Row

edit

voici la solution :

    Dim Code As String, LigF As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Sheets("ENREGISTREMENT")
    Set ws2 = Sheets("Liste_documentation")

    For i = 15 To ws1.Range("A65536").End(xlUp).Row
        If ws1.Range("A" & i).Value = "DIFFUSION" Then
            Code = ws1.Range("B" & i) & Format(ws1.Range("C" & i), "000")
            LigF = 0
         set X =   ws2.Columns("D:D").Find(What:=Code, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False)          
            if not X is nothing then       
                 LigF =  X.Row
             else 
                LigF = ws2.Range("A65536").End(xlUp).Row + 1
            End If
            ws2.Cells(LigF, "D").Value = ws1.Range("D" & i).Value
            ws2.Cells(LigF, "E").Value = ws1.Range("E" & i).Value
            ws2.Cells(LigF, "F").Value = ws1.Range("F" & i).Value
            ws2.Cells(LigF, "G").Value = ws1.Range("G" & i).Value
            ws2.Cells(LigF, "I").Value = ws1.Range("I" & i).Value
        End If
    Next i

 

[grosquick59]

Re : VBA rechercher + copier/coller

Je reviens sur le post car j'ai encore un souci. En réalité lorsque la ligne n'existe pas la macro créée cette donnée à la dernière ligne non vide. Jusque là c'est ok.
Le problème est qu'il ne créée une ligne qu'une seule fois alors que potentiellement je peux avoir 15 lignes nouvelles.

Pourriez-vous m'aider svp ?

 

[grosquick59]

Re : VBA rechercher + copier/coller

OK j'ai compris mon problème venait de la recherche. il faut remplacer LigF

LigF = ws2.Range("D10000").End(xlUp).Row + 1

 

[karybou]

Re : VBA rechercher + copier/coller

Hello,
Je tombe sur votre post et c'est exactement ce type de fichier qu'il me faut pour la gestion documentaire des docs qualité.
Par contre je ne suis pas du tout doué pour ce qui est des codes.
Avez-vous la possibilité de remettre le fichier corrigé, se serait vraiment cool.
Merci d'avance.
K.