Discussion :

[BAHIRI]

Bonjour Forum,
Pour effectuer le traitement pour toutes les autres familles existantes un tableau constitué de plusieurs variables du même type est crée. Il est composé de 4 éléments : Bois, Jardin, Décoration et Bricolage.
Ma question : dans le cas où le nombre de familles d'article dépasse 50 ou plus, comment éviter la saisie des noms en forçant une recherche dans une liste prédfinie. Il se peut que je soit dans l'erreur.

Merci par avance.

Cordialement

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
Sub PrcVentilation()
    Dim ZCpt As Long
    Dim ZFamille As String
 
    Dim ZListeFam(4) As String
    ZListeFam(1) = "Bois"
    ZListeFam(2) = "Jardin"
    ZListeFam(3) = "Décoration"
    ZListeFam(4) = "Bricolage"
 
    Range("A4").Select
    Selection.AutoFilter
 
    If Dir("C:\Articles", vbDirectory) = "" Then MkDir ("C:\Articles")
 
    For ZCpt = 1 To UBound(ZListeFam)
 
        Z_Famille = UCase(ZListeFam(ZCpt))
        Selection.AutoFilter Field:=1, Criteria1:=ZFamille

[mercatog]

Une proposition si elle convient

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
Sub PrcVentilation()
Dim ZCpt As Long, NbFam As Long
Dim ZListeFam As New Collection
 
Application.ScreenUpdating = False
 
If Dir("C:\Articles", vbDirectory) = "" Then MkDir ("C:\Articles")
 
With Sheets("Feuil1")   'à adapter
    NbFam = .Cells(Rows.Count, 1).End(xlUp).Row
 
    For ZCpt = 5 To NbFam       'Données commencent en 5ème ligne
        On Error Resume Next
            .Range("A" & ZCpt) = UCase(Trim(.Range("A" & ZCpt)))
            ZListeFam.Add .Range("A" & ZCpt), .Range("A" & ZCpt)
        On Error GoTo 0
    Next ZCpt
 
    With Range("A4")
        For ZCpt = 1 To ZListeFam.Count
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:=ZListeFam(ZCpt)
            '...suite code et traitement à effectuer après filtrage
        Next ZCpt
          .AutoFilter
    End With
End With
End Sub

[BAHIRI]

Bonsoir Mecatog et Forum.

Merci pour ton code. Après test, la variable ZFamille reste vide. Elle doit prendre comme valeur la famille d'article de type "BRICOLAGE" pour eviter de réecrir le même fichier de nom "Articles". Le nom attendu est de type "Articles BRICOLAGE".
le code est :

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
Sub PrcVentilation_Dev()
Dim ZCpt As Long, NbFam As Long
Dim ZListeFam As New Collection
Dim ZFamille As String
 
 
Application.ScreenUpdating = False
 
If Dir("C:\Articles", vbDirectory) = "" Then MkDir ("C:\Articles")
 
With Sheets("Base")   'à adapter
    NbFam = .Cells(Rows.Count, 1).End(xlUp).Row
 
    For ZCpt = 5 To NbFam       'Données commencent en 5ème ligne
        On Error Resume Next
            .Range("A" & ZCpt) = UCase(Trim(.Range("A" & ZCpt)))
            ZListeFam.Add .Range("A" & ZCpt), .Range("A" & ZCpt)
        On Error GoTo 0
    Next ZCpt
 
    With Range("A4")
        For ZCpt = 1 To ZListeFam.Count 
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:=ZListeFam(ZCpt)
 
            Selection.CurrentRegion.Select
            Selection.Copy
            Workbooks.Add
            ActiveSheet.Paste
            ActiveWorkbook.SaveAs Filename:="C:\Articles\Articles" & ZFamille & ".xls"
            ActiveWorkbook.Close
            Application.CutCopyMode = False
 
        Next ZCpt
          .AutoFilter
    End With
End With
End Sub

[mercatog]

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
Dim ZCpt As Long, NbFam As Long
Dim ZListeFam As New Collection
Dim wbk As Workbook
 
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Dir("C:\Articles", vbDirectory) = "" Then MkDir ("C:\Articles")
 
With Sheets("Base")   'à adapter
    NbFam = .Cells(Rows.Count, 1).End(xlUp).Row
 
    For ZCpt = 5 To NbFam       'Données commencent en 5ème ligne
        On Error Resume Next
            .Range("A" & ZCpt) = UCase(Trim(.Range("A" & ZCpt)))
            ZListeFam.Add .Range("A" & ZCpt), .Range("A" & ZCpt)
        On Error GoTo 0
    Next ZCpt
 
    With .Range("A4:X" & NbFam)
        For ZCpt = 1 To ZListeFam.Count
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:=ZListeFam(ZCpt)
            Set wbk = Workbooks.Add(1)
            .SpecialCells(xlCellTypeVisible).Copy wbk.Sheets(1).Range("A1")
            wbk.SaveAs Filename:="C:\Articles\Articles\" & ZListeFam(ZCpt) & ".xls"
            wbk.Close
        Next ZCpt
          .AutoFilter
    End With
End With
Application.DisplayAlerts = True

[BAHIRI]

Bonsoir,

Je vous remercie pour les solutions proposées et toutes mes excuses pour cette réponse tardive. Je viens de reprendre ce projet pour le clôturer.

Cordialement