XL 2016 Extraire des données

[ROI1482]

Bonjour,
A partir d'une feuille "Base" contenant des données j'extrait celles commençant par CLXXXX et les recopie dans la feuille "Result" pour cela j'utilise le filtrage aavancé.
N'existerait il pas une fonction pour simplifier le processus.
Je joint fichier exemple
Merci

 

[Phil69970]

@ROI1482

Vu la rapidité du retour la dernière fois Je vais m'abstenir

 

[ROI1482]

@ROI1482

Vu la rapidité du retour la dernière fois Je vais m'abstenir

j'ai bien remercié la dernière mais n'ai peut être pas validé la réponse et m'excuse de cette fausse manip.
sincères regrets

 

[sousou]

Bonjour
Avec un bout de code

 

[ROI1482]

Bonjour
Avec un bout de m

 

[ROI1482]

Merci je vais utiliser ce code qui fonctionne parfaitement et le tester dans mon classeur
Bonne soirée

 

[Franc58]

Salut, une suggestion avec utilisation de tableau en mémoire pour plus de performance en cas de beaucoup de lignes à traiter.

Sub CopierCollerLignes()
    Dim wsBase As Worksheet
    Dim wsResult As Worksheet
    Dim data As Variant
    Dim i As Long
    Dim ref As String
    Dim startRow As Long
    Dim endRow As Long
    
    Set wsBase = ThisWorkbook.Sheets("Base")
    Set wsResult = ThisWorkbook.Sheets("Result")
    
    ref = wsResult.Range("B2").Value
    
    wsResult.Range("C2:Q" & wsResult.Cells(wsResult.Rows.Count, "D").End(xlUp).Row).ClearContents
    
    data = wsBase.Range("A2:O" & wsBase.Cells(wsBase.Rows.Count, "A").End(xlUp).Row).Value
    
    Application.ScreenUpdating = False
    
    For i = 1 To UBound(data, 1)
        ' Si la cellule commence par la référence
        If Left(data(i, 1), Len(ref)) = ref Then
            ' Copier la ligne du tableau dans "Result"
            wsResult.Range("C" & wsResult.Cells(wsResult.Rows.Count, "C").End(xlUp).Row + 1 & ":Q" & wsResult.Cells(wsResult.Rows.Count, "C").End(xlUp).Row + 1).Value = Application.Index(data, i, 0)
        ElseIf Left(data(i, 1), Len(ref)) > ref Then
            ' Si la cellule contient une valeur supérieure à la référence, quitter la boucle
            Exit For
        End If
    Next i
    
    Set wsBase = Nothing
    Set wsResult = Nothing
    
End Sub