Copier certaines lignes d'un fichier Excel dans un nouveau fichier Excel

Question

Je souhaite créer une macro qui va copier, pour chaque feuille du classeur, les lignes 1 et les lignes contenant "Tech 8" en colonne C dans un nouveau fichier. J'ai créé la boucle pour analyser chaque feuille mais ne sais pas comment faire le copier coller dans un nouveau fichier. En pièces jointes vous trouverez le fichier de base et le fichier du résultat attendu...

ThauThème · Answer

Bonsoir Cédic, bonsoir le forum,

Une méthode parmi d'autres... Essaie avec le code ci-dessous à placer dans le classeur de base :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim I As Integer 'déclare la variable I (Incrément)
Dim PL As Range 'déclare la variable PL (PLage)

Set CS = ThisWorkbook 'définit le classeur source CS
Workbooks.Add 'ajoute un classeur vierge
Set CD = ActiveWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD (ici le premier onglet du classeur destination)
For Each O In CS.Worksheets 'boucle 1 : sur tous les onglets O du classeur source
    Set PL = O.Range("A1") 'initialise la plage PL
    TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
    O.Rows(1).Copy 'copy la ligne 1 de l'onglet O
    If OD.Range("B1").Value = "" Then 'condition 1 : si B1 de l'onglet destination est vide
        Set DEST = OD.Range("A1") 'définit la celllule de destination DEST (A1 de l'onglet destination)
    Else 'sinon
        'définit la celllule de destination DEST (la première cellule vide de la colonne A de l'onglet OD)
        Set DEST = OD.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, -1)
    End If 'fin de la condition 1
    DEST.PasteSpecial (xlPasteAllUsingSourceTheme) 'copie la ligne 1 dans DEST
    DEST.PasteSpecial (xlPasteColumnWidths) 'copie la largeur des colonnes
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les ligne I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 3) = "Tech 8" Then 'condition 2 : si la donnée ligne I colonne 3 est égale à "Tech 8"
            Set PL = IIf(PL.Cells.Count = 1, O.Rows(I), Application.Union(PL, O.Rows(I))) 'redéfinit la plage PL
        End If 'fin de la condition 2
    Next I 'prochaine ligne de la boucle 2
    PL.Copy DEST.Offset(1, 0) 'copie la plage PL et la colle dans DEST décalée d'une ligne
Next O 'prochain onglet de la boucle 1
'condition : si Oui au message
If MsgBox("Voulez-vous enregistrer le classeur ?", vbYesNo, "Sauvegarde") = vbYes Then
    Application.FileDialog(msoFileDialogSaveAs).Show 'ouvre la boîte de dialogue pour enregistgrer le fichier
End If 'fin de la condition
End Sub