Copie ligne complete sous codition

[NICOALBERT]

Bonsoir,

Je voudrais pouvoir copier les lignes entières sous la condition qu'elles se trouvent sous COURSE N°01,COURSE N°02,Course N°03 etc... jusqu'à COURSE N°09.

Et les coller dans une autre feuille du même classeur.

N.B🙁Les lignes à copier sont en jaune dans ce fichier mais non pas de couleur dans le fichier originale)et sachant également que les lignes ne sont jamais au même endroit.

Cordialement NICOALBERT

 

[Robert]

Re : Copie ligne complete sous codition

Bonsoir Nicoalbert, bonsoir le forum,

En piece jointe ton fichier modifié avec la macro ci dessous :

Sub Macro1()
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclarare la variable pa (Première Adresse)
Dim x As Byte 'déclare la variable x
 
With Sheets("Feuil1").Columns(2) 'prend en compte la colonne B de l'onglet "Feuil1"
    For x = 1 To 9 'boucle sur les 9 courses
        Set r = .Find("COURSE N°0" & CStr(x)) 'définit la variable r
        If Not r Is Nothing Then 'condition : si il existe au moint une occurrence de r
            Set dest = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            dest.Value = "COURSE N°0" & CStr(x) 'place l'en-tête
            pa = r.Address 'définit la variable pa
            Do 'exécute
                Set dest = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0) 'redéfinit la variable dest
                r.Offset(1, 0).Copy Destination:=dest 'copie la ligne en dessous de r
                Set r = .FindNext(r) 'redéfinit la variable r
            Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences de r ailleurs qu'en pa
        End If 'fin de la condition
    Next x 'prochaine course
End With 'fin de la prise en compte de la colonne B de l'onglet "Feuil1"
End Sub

 

[NICOALBERT]

Re : Copie ligne complete sous codition

bonsoir,

Merci pour ce fichier joint mais en faite je voudrais que ce soit toute la ligne et non pas une seul cellule qui soit copier.

Cordialement NICOALBERT.

 

[Robert]

Re : Copie ligne complete sous codition

Bonsoir Nicoalbert, bonsoir le forum

En rouge la modif dans la macro

Sub Macro1()
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclarare la variable pa (Première Adresse)
Dim x As Byte 'déclare la variable x
 
With Sheets("Feuil1").Columns(2) 'prend en compte la colonne B de l'onglet "Feuil1"
    For x = 1 To 9 'boucle sur les 9 courses
        Set r = .Find("COURSE N°0" & CStr(x)) 'définit la variable r
        If Not r Is Nothing Then 'condition : si il existe au moint une occurrence de r
            Set dest = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            dest.Value = "COURSE N°0" & CStr(x) 'place l'en-tête
            pa = r.Address 'définit la variable pa
            Do 'exécute
                Set dest = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0) 'redéfinit la variable dest
                r.Offset(1, 0)[COLOR=red].EntireRow[/COLOR].Copy Destination:=dest 'copie la ligne en dessous de r
                Set r = .FindNext(r) 'redéfinit la variable r
            Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences de r ailleurs qu'en pa
        End If 'fin de la condition
    Next x 'prochaine course
End With 'fin de la prise en compte de la colonne B de l'onglet "Feuil1"
End Sub