Export lignes tableau avec conditions vers nouveau classeur

Bonjour à tous,

J'ai besoin d'un coup de main pour modifier cette macro d'export de ligne

Sub Export()

Dim plage As Range
Dim x As Long
Dim c

With Sheets("Contacts")

    Set plage = .Range("D3:D" & .Range("C65000").End(xlUp).Row)

    For Each c In plage
        If c.Value = "CCCT" Then
            x = Sheets("feuil1").Range("C65000").End(xlUp).Row + 1
            c.EntireRow.Copy Sheets("feuil1").Rows(x)

        ElseIf c.Value = "CCMAV" Then
            x = Sheets("feuil2").Range("c65000").End(xlUp).Row + 1
            c.EntireRow.Copy Sheets("feuil2").Rows(x)

        End If

    Next c

End With

End Sub

Je voudrais la modifier pour :

- Exporter les données vers deux nouveaux classeurs "Contacts_CCCT_Sem(N°semaine).xls" et "Contacts_CCMAV_Sem(N°semaine).xls" dans le même dossier que le classeur CONTACT.xlsm

- Garder l'entête du tableau Ligne 1 et 2, les filtres, les formats et les MFC

Merci d'avance pour votre aide

2contacts.xlsm (272.42 Ko)
3contacts.xlsm (270.78 Ko)

Bonjour à tous

J'ai un peu avancé (bidouillé est plus approprié) ma macro mais je bute sur la partie copie/colle avec les conditions, la macro tourne sans résultat...

Pour rappel ,

A partir de mon tableau contacts.xlsm

Je veux exporter toutes les lignes contenant "CCCT" dans la colonne D vers un nouveau classeur "Extrait_Contacts_CCCT_Sem(N°Sem).xlsx"

Idem pour la valeur "CCMAV" de la colonne D vers un nouveau classeur "Extrait_Contacts_CCMAV_Sem(N°Sem).xlsx"

L'idéal serait de pouvoir garder tous les entêtes de tableau, filtres, formats et mise en forme conditionnelle dans les 2 nouveaux classeurs

Pour l'instant ma macro marche pour la partie création classeur, nommage de feuille et enregistrement au bon endroit...

Voici mon nouveau code qui est loin d'être pro et propre mais il fonctionne :)

Merci !

Sub Export()

Dim xlBook_CCCT As Workbook
Dim xlBook_CCMAV As Workbook
Dim xlSheet_CCCT As Worksheet
Dim xlSheet_CCMAV As Worksheet
NumSem = Format(Date, "WW")
NomFichier_CCCT = ThisWorkbook.Path & "\" & "Extrait_Contacts_CCCT" & "_" & "Sem" & NumSem & ".xlsx"
NomFichier_CCMAV = ThisWorkbook.Path & "\" & "Extrait_Contacts_CCMAV" & "_" & "Sem" & NumSem & ".xlsx"
Dim plage As Range
Dim x As Long
Dim c

'Ajoute un classeur, ajoute une feuille, nomme la feuille, nomme le classeur pour CCCT
With xlBook_CCT
Set xlBook_CCCT = Workbooks.Add
Application.SheetsInNewWorkbook = 1
Set xlSheet_CCCT = xlBook_CCCT.Worksheets(1)
xlSheet_CCCT.Name = "CCCT" & "_" & "Sem" & NumSem
xlBook_CCCT.SaveAs Filename:=NomFichier_CCCT
End With

'Ajoute un classeur, ajoute une feuille, nomme la feuille, nomme le classeur pour CCMAV
With xlBook_CCMAV
Set xlBook_CCMAV = Workbooks.Add
Application.SheetsInNewWorkbook = 1
Set xlSheet_CCMAV = xlBook_CCMAV.Worksheets(1)
xlSheet_CCMAV.Name = "CCMAV" & "_" & "Sem" & NumSem
xlBook_CCMAV.SaveAs Filename:=NomFichier_CCMAV
End With

With ThisWorkbook.Sheets("Contacts")

     Set plage = .Range("D3:D" & .Range("C65000").End(xlUp).Row)

     For Each c In plage
         If c.Value = "CCCT" Then
             x = ThisWorkbook.Sheets("Contacts").Range("C65000").End(xlUp).Row + 1
             c.EntireRow.Copy xlSheet_CCCT.Rows(x)

         ElseIf c.Value = "CCMAV" Then
             x = ThisWorkbook.Sheets("Contacts").Range("c65000").End(xlUp).Row + 1
             c.EntireRow.Copy xlSheet_CCMAV.Rows(x)

         End If

    Next c

End With

'Ferme les classeurs CCCT et CCCT
With xlBook_CCCT
.Close
End With

With xlBook_CCMAV
.Close
End With

End Sub
Rechercher des sujets similaires à "export lignes tableau conditions nouveau classeur"