Discussion :

[fred792]

Bonjour à tous,

J'ai un classeur contenant plusieurs feuilles dont 1 que je souhaite exporter dans un nouveau classeur suivant 2 dates : Date_debutExport et Date_finExport.

Le filtre des dates ne fonctionnent pas (il supprime tout) et le filtre s'applique au classeur d'origine et pas à celui exporté.

J'ai cherché partout et impossible de résoudre le problème.

Si vous pouviez me filer un coup de main.

Merci par avance.

Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Dim chemin_export, Fichier, date_export As String
Dim Date_debutExport, Date_finExport, Date_ref As Date
Dim i As Long
Dim Plage As Range
 
rep = MsgBox("Voulez-vous exporter dans un fichier CRM ?", vbOKCancel, "Exportation")
 
If rep = 1 Then
 
    Date_debutExport = ActiveWorkbook.Sheets("Export_CRM").Range("Date_debutExport") 
    Date_debutExport = Format(Date_debutExport, "dd/mm/yyyy")
 
    Date_finExport = ActiveWorkbook.Sheets("Export_CRM").Range("Date_finExport")
    Date_finExport = Format(Date_finExport, "dd/mm/yyyy")
 
    chemin_export = ActiveWorkbook.Sheets("Param").Range("File_ExportCRM")
 
    date_export = Now
    date_export = Format(date_export, "ddmmyyyy_hhmm")
 
    NomTableau = "Export" & date_export
 
    'Application.DisplayAlerts = False 'pas d'alerte
 
    ActiveWorkbook.Sheets("Export_CRM").Copy 'copie de l'onglet Export_CRM vers nouveau classeur
 
    'MISE EN FORME DE LA FEUILLE
    ActiveWorkbook.Sheets("Export_CRM").btn_ExportCRM.Visible = False 'cache le bouton d'exportation
 
    '####################################################################################
    '   Suppression des lignes
    '####################################################################################
 
   With ActiveWorkbook.Sheets("Export_CRM")
        Set Plage = Range("C4", Range("C65536").End(xlUp))
        For i = Plage.Cells.Count To 1 Step -1
            If (Plage.Cells(i).Value < Date_debutExport) Then 'Or (Plage.Cells(i).Value > Date_finExport) Then
                Plage.Cells(i).EntireRow.Delete
            End If
        Next i
    End With
 
'####################################################################################
 
    'Application.ScreenUpdating = True
 
    'Nomme le fichier créé
    Fichier = chemin_export & "\" & NomTableau & ".xls"
    ActiveWorkbook.SaveAs Fichier
    ActiveWorkbook.Close
 
End If

[fring]

Bonjour,

J'ai adapté ton code ci-dessous, déclaré les variables en spécifiant le type et supprimé ce qui était inutile comme par exemple la mise en forme des variables "dates"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub test()
Dim chemin_export As String, i As Long
Dim Date_debutExport As Date, Date_finExport As Date
Dim NewWbk As Workbook, NomTableau As String
 
Application.ScreenUpdating = False
rep = MsgBox("Voulez-vous exporter dans un fichier CRM ?", vbOKCancel, "Exportation")
 
If rep = 1 Then
 
    Date_debutExport = ThisWorkbook.Sheets("Export_CRM").Range("Date_debutExport")
    Date_finExport = ThisWorkbook.Sheets("Export_CRM").Range("Date_finExport")
    chemin_export = ThisWorkbook.Sheets("Param").Range("File_ExportCRM")
 
    NomTableau = "Export" & Format(Now, "ddmmyyyy_hhmm")
 
    ThisWorkbook.Sheets("Export_CRM").Copy 'copie de l'onglet Export_CRM vers nouveau classeur
    Set NewWbk = ActiveWorkbook
 
    'MISE EN FORME DE LA FEUILLE
    NewWbk.Sheets("Export_CRM").Shapes("btn_ExportCRM").Delete 'supprime le bouton d'exportation
 
    '####################################################################################
    '   Suppression des lignes
    '####################################################################################
 
   With NewWbk.Sheets("Export_CRM")
        For i = .Range("C65536").End(xlUp).Row To 1 Step -1
            If .Cells(i, 3) < Date_debutExport Or .Cells(i, 3) > Date_finExport Then
                .Cells(i, 3).EntireRow.Delete
            End If
        Next i
    End With
 
    '####################################################################################
 
    'Nomme le fichier créé
    NewWbk.SaveAs chemin_export & "\" & NomTableau & ".xls"
    NewWbk.Close
 
End If
 
Application.ScreenUpdating = True
End Sub

Testé et le résultat attendu est obtenu

Cdlt

[fred792]

Merci pour ta réponse excellente.

J'ai avancé d'un grand pas.

Juste en complément:

Je dois garder la ligne 1 et 3 (commentaires et entêtes de tableau).

Dois-je copier/coller les lignes en les insérant dans le nouveau fichier exporté ou puis-je limiter la boucle pour qu'elle s'arrête à la ligne 3 ?

Merci pour vos réponses.

[fring]

Tu arrêtes ta boucle où tu veux
For i = xxx to 1 Step - 1 --> la boucle ira jusque la ligne 1
For i = xxx to 4 Step - 1 --> la boucle ira jusque la ligne 4
etc...

[fred792]

Merci Fring,

Résultat attendu parfait.

Encore merci.