Générer tableau a partir d'un autre avec conditions

[pmfontaine]

Bonjour,
En VBA, je cherche a générer un fichier excel dans lequel je veux mettre uniquement les lignes d'une autre tableau qui correspondent à deux conditions.
Mais mais connaissance sur les tableaux sont trop faible pour que j'y arrive.
Voir mon approche dans le fichier joint
Merci pour votre aide
Patrick

 

[Jacky67]

Bonjour,
Cela pourrait ressembler à ceci

Sub copier()
Dim i As Long
Sheets("BD").Copy
For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
    If UCase(Cells(i, 5)) & UCase(Cells(i, 6)) <> "OUINON" Then Rows(i).Delete
Next
With ActiveWorkbook
    .SaveAs ThisWorkbook.Path & "\TRANSFERE.xls", FileFormat:=xlExcel8
    .Close
End With
MsgBox "Le fichier TRANSFERE.xls est dans le même dossier que ce fichier"
End Sub

 

[pmfontaine]

Bonjour,
Merci Jacky67.
Oui ça marche, mais mon fichier a plus de 10 000 ligne, et il me semble que ta méthode sera beaucoup plus longue qu'en passant par l'intermédiaire d'un tableau.
Si quelqu'un a une version avec tableau (Voir mon code), ça m’intéresserais de faire la différence.
Merci
Patrick

 

[chris]

Bonjour

Sinon un filtre élaboré

Sub Transfert()
'
Chemin = ActiveWorkbook.Path
    With ActiveWorkbook.Worksheets("BD")
        Mafeuille = .Name
        .Range("E1:F1").Copy Destination:=.Range("K1")
        .Range("K2").Value = "OUI"
        .Range("L2").Value = "NON"
        .Range("A1:F1").Copy
        Workbooks.Add
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Workbooks("TransfèreDonnées2.xlsm").Sheets("BD").Columns("A:F").AdvancedFilter _
            Action:=xlFilterCopy, CriteriaRange:=Workbooks("TransfèreDonnées2.xlsm"). _
            Sheets(Mafeuille).Range("K1:L2"), CopyToRange:=Columns("A:F"), Unique:=False
        Columns("A:F").EntireColumn.AutoFit
        ActiveWorkbook.SaveAs Filename:=Chemin & "\Extrait.xlsx", FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWindow.Close
        .Range("K1:L2").ClearContents
    End With
End Sub

 

[pmfontaine]

Super,
Merci beaucoup Chris.
ça marche avec un temps d’exécution pratiquement instantané sur 9000 lignes.
Patrick