[XL-2007] question de sélections multiples aléatoire [Résolu]

[tompom3108]

Bonjour est il possible de sélectionner plusieurs feuilles afin de les copier et de les enregistrer dans un classeur?

Je m'explique j'ai un classeur avec différentes feuilles dans l'ordre :
"Menu", "Devis", "Fichier_client", Base_Produit", "Position".

De temps en temps, il m'arrive d'ajouter d'autres onglets après "devis" appelés "Détail 1", "Détail 2", "Détail n+1" etc...

Mon code pour sauver la feuille Devis était :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
repertoire = Sheets("Menu").Range("C9").Value
            Num_Fact = Range("F19").Value
        Nom_client = Range("J13").Value
    ActiveSheet.Copy
Cells.Copy
  Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,       SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=repertoire & Num_Fact & " " & Nom_client & ".xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        Application.Goto Reference:="Sousdetail"        
ActiveWorkbook.Close

Je voudrais savoir comment remplacer le

Code :

ActiveSheet.copy

Pour qu'à la fois les feuilles "Devis" et les feuilles "Détail 1" 2 3 etc. si elles existent soient enregistrées.

J'ai ce bout de code

Code :

Sheets(Array("Devis", "Détail  1", "Détail  2")).Select

Mais je ne sais pas comment déclarer les variables ou quelles instructions utiliser pour faire en sorte que quelque soit le nombre de feuilles "détails" elles soient prises en compte dans

Code :

Sheets(Array("Devis", "variable")).Select

merci aux patients qui répondront.

[Daniel.C]

Bonjour,

Essaie :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test3()
    Dim Sh As Worksheet, Tabl() As String, Ctr As Long
    ReDim Tabl(0)
    Ctr = -1
    For Each Sh In Worksheets
        If Sh.Name = "Devis" Or Left(Sh.Name, 6) = "détail" Then
            Ctr = Ctr + 1
            ReDim Preserve Tabl(Ctr)
            Tabl(Ctr) = Sh.Name
        End If
    Next
    Sheets(Tabl()).Copy
End Sub

[mercatog]

Code :

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
Sub Test()
Dim Rep As String, NumFact As String, Client As String, Tb() As String
Dim Sh As Worksheet
Dim j As Byte
 
Application.ScreenUpdating = False
'Initialisation variables
Rep = Worksheets("Menu").Range("C9").Value
With Worksheets("Devis")
    NumFact = .Range("F19").Value
    Client = .Range("J13").Value
End With
 
'Recherche des feuilles à enregistrer
ReDim Tb(0)
Tb(0) = "Devis"
For Each Sh In ThisWorkbook.Worksheets
    If InStr(Sh.Name, "Détail") > 0 Then
        j = j + 1
        ReDim Preserve Tb(0 To j)
        Tb(j) = Sh.Name
    End If
Next Sh
 
'enregistrement des feuilles trouvées
Worksheets(Tb).Copy
With ActiveWorkbook
    For Each Sh In .Worksheets
        Sh.UsedRange.Value = Sh.UsedRange.Value
    Next Sh
    Application.DisplayAlerts = False
    .SaveAs Filename:=Rep & NumFact & " " & Client & ".xls", FileFormat:=xlExcel8
    .Close False
    Application.DisplayAlerts = True
End With
End Sub

[tompom3108]

D'accord merci pour votre temps.