Recopie de ligne

[jenoca]

Bonjour,

Je suis a la recherche d'une solution pour mon petit probleme.
Je souhaiterai pour voir recopier des lignes selectionnées par le mot "Oui" dans une colone vers une feuille nommée 'Copie".

Voir le petit fichier.

Merci a vous tous

 

[Cousinhub]

Re : Recopie de ligne

Bonjour,

regarde le fichier joint

le code :

Sub extract()
Range("A2:C" & [A65000].End(xlUp).Row).Name = "base"
[F1] = [C2]: [F2] = "oui"
With Sheets("copie")
    Range("A2:C2").Copy .[A1]
    Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("F1:F2"), _
        CopyToRange:=.Range("A1:C1"), Unique:=False
End With
Range("F1:F2").ClearContents
End Sub

le fichier :

 

[Excel-lent]

Re : Recopie de ligne

Bonjour et bienvenu sur le forum Jenoca,

Voici une solution en VBA, macro ci-dessous à mettre où tu veux!

Dans module, sur la feuille 1, ...

Sub oui()
' Macro enregistré par Excel-lent

Dim NbLigneListing As Long
Dim NbLigneCopie As Long

Sheets("copie").Select

With Sheets("Listing")
    NbLigneListing = .[A65536].End(xlUp).Row
    NbLigneCopie = 2
    
    For i = 3 To NbLigneListing
       If .Range("C" & i) = "oui" Then
         .Range("A" & i & ":C" & i).Copy
         Range("A" & NbLigneCopie).Select
         ActiveSheet.Paste
         NbLigneCopie = NbLigneCopie + 1
       End If
    Next i
End With

End Sub

Bon Samedi

Edition : bonjour Bhbh

 

[vbacrumble]

Re : Recopie de ligne

Bonjour tous


Une autre proposition (avec l'autofilter)

Sub copies()
Dim pf As Range, pfc As Range
Application.ScreenUpdating = False
With Sheets("listing")
    [A2].AutoFilter 3, "oui"
    Set pf = Range("_FilterDataBase")
    Set pfc = pf.Offset(1, 0).Resize(pf.Rows.Count - 1)
    pfc.SpecialCells(8).Copy Sheets("copie").Range("A1")
    .AutoFilterMode = False
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[jenoca]

Re : Recopie de ligne

Merci pour vos réponses, j'ai testé sur le fichier final et ca fonctionne correctement.

Bravo pour la rapidité.