Copier plage de cellules vers autre feuille sous condition

Fermé
Sof2Lyon Messages postés 26 Date d'inscription mardi 12 mai 2009 Statut Membre Dernière intervention 12 octobre 2018 - 27 juin 2017 à 17:34
Sof2Lyon Messages postés 26 Date d'inscription mardi 12 mai 2009 Statut Membre Dernière intervention 12 octobre 2018 - 28 juin 2017 à 08:08
Bonjour,

Je suis à la recherche d'une aide sur une macro VBA qui a fonctionné mais ne semble plus vouloir faire ce que je veux.
Je suis loin d'être experte en VBA aussi je me permets de faire appel à vos lumières.

Je souhaite faire l'enchaînement suivant dans un fichier contenant 3 feuilles :
1. dans la feuille "Compilation" (où j'ai ajouté le bouton pour lancer la Macro), sans considérer la ligne 1 d'entête, identifier l'ensemble de caractères avant l'espace dans la cellule D2
2.rechercher cet ensemble de caractère dans la feuille "CAPA"
3. si retrouvé alors copier la plage de la ligne correspondante (colonne A à R) dans la feuille "Compilation" à partir de la colonne O2.
4. continuer de même jusqu'à la dernière ligne avec contenu de la feuille "CAPA"

Si dessous le code qui ne veut plus fonctionner.

Sub CompilationCAPA()

Dim i As Long
Dim ref As String
Dim rng1 As Range
Dim f As Worksheet
    Set f = ActiveSheet
    
    i = 2

'Worksheets("CAPA").Range("A" & 1 & ":R" & 1).Copy Destination:=ActiveSheet.Range("O" & 1)

    While f.Cells(i, 1) <> ""
        ref = CStr(Split(f.Cells(i, 4), " ")(0))
        Set rng1 = Worksheets("CAPA").Range("A:A").Find(ref, , xlValues, xlWhole)
            If Not rng1 Is Nothing Then
                
                'message pouvant être affiché
                'MsgBox "Find has matched " & strSearch & vbNewLine & "corresponding cell is " & rng1.Row'
                MsgBox "Référence CAPA retrouvée " & strSearch & vbNewLine & "sur la ligne Action " & rng1.Row '
                
                Worksheets("CAPA").Range("A" & rng1.Row & ":R" & rng1.Row).Copy Destination:=ActiveSheet.Range("O" & i)
                
            Else
            
            MsgBox strSearch & " not found"
            
            End If
            
        Set rng1 = Nothing
    i = i + 1
    Wend
        
    Set f = Nothing
End Sub


En cas de besoin, le lien vers le fichier :
http://www.cjoint.com/c/GFBpmNh1uPM


Si vous voyez l'erreur, merci d'avance pour votre aide précieuse !

1 réponse

ccm81 Messages postés 10543 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 18 mars 2023 2 336
27 juin 2017 à 18:11
Bonjour

la recherche dans la feuille CAPA se fait en colonne C et non A
Set rng1 = Worksheets("CAPA").Range("C:C").Find(ref, , xlValues, xlWhole)

Cdlmnt
0
Sof2Lyon Messages postés 26 Date d'inscription mardi 12 mai 2009 Statut Membre Dernière intervention 12 octobre 2018
28 juin 2017 à 08:08
Bonjour, merci beaucoup pour votre réponse.
Je testerai cela cet après-midi et reviens vous dire si c'est en effet là que se trouvait la boulette.
0