Discussion :

[JadonScho]

Bonjour, voici le code que j'ai trouvé sur le site et adapté à ma situation. Le but est de filtrer sur chaque commerciaux et extraire vers un autre fichier les données filtrées, puis enregistrer le classeur. Sauf que là, les données sont copiés dans un nouveau classeur. Or j'aimerais moi que mes données filtrés soient collés dans un de mes classeurs existant,et non pas dans un nouveau classeur. L'idéal serait que pour chaque commercial, les données filtrés soient copiés dans un classeur existant ( qui est sur mon bureau), puis enregistrer sous dans un répertoire. (avec le nom du commercial)

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
Option Explicit
 
Sub Traitement()
 
Dim CollMag As New Collection
Dim Plage As Range
Dim L As Long, L2 As Long, Lmax As Long
Application.ScreenUpdating = False
With Sheets("clients")
    Lmax = .Cells(Application.Rows.Count, 1).End(xlUp).Row
 
    On Error Resume Next
    For L = 2 To Lmax
        CollMag.Add .Cells(L, 2).Text, .Cells(L, 2).Text
    Next L
    On Error GoTo 0
    'Création des classeurs
    For L = 3 To CollMag.Count
        'Copie de l'onglet
        .Copy
 
        With ActiveSheet
            Set Plage = .Rows(Application.Rows.Count)
            For L2 = 4 To Lmax
                If .Cells(L2, 2).Text <> CollMag(L) Then
                    Set Plage = Union(Plage, .Rows(L2))
                End If
            Next L2
            Plage.Delete
        End With
        'Sauvegarde classeur "magasin X"
        With ActiveWorkbook
            .SaveAs ThisWorkbook.Path & "\Mag " & CollMag(L) & ".xls"
             .Close
        End With
    Next L
End With
End Sub

Merci d'avance

[EricDgn]

Bonjour,

Une façon de faire:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
...
'Sauvegarde classeur "magasin X"
CopySheet ActiveSheet, ThisWorkbook.Path & "\Mag " & CollMag(L) & ".xlsx"
...
 
Sub CopySheet(wshA As Worksheet, sWBPath As String)
   Dim wbB As Workbook
   Application.ScreenUpdating = False
   Set wbB = Workbooks.Open(sWBPath)  '--- et erreur si fichier n'existe pas
   wshA.Copy Before:=wbB.Sheets(1)
   wbB.Close SaveChanges:=True
   Application.ScreenUpdating = True
End Sub

A noter qu'il faut que l'extension du fichier de destination soit du même genre que le fichier de départ (.xlm >> .xlm, .xls ; .xlsm >> .xlsm, .xlsx).


Bonne continuation.