Discussion :

[kmario]

*Bonjour,*

je veux créer un classeur et copier les feuilles d'un classeur existant pour coller dans le nouveau. je réussis à créer le nouveau classeur mais au moment de la copie j'ai une erreur "l'indice n'appartient pas à la sélection" sur le code "Set CL2 = Workbooks("Frais de")". j'aimerais aussi indiquer le répertoire où je crée mon classeur. Merci d'avance
Voilà mon 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
53
54
55
56
57
58
59
Sub CopieDeFeuillesChoisies()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim CL1 As Workbook
Dim CL2 As Workbook
Dim LaFeuille As Worksheet
Dim i As Byte, ListeACopier As Variant
Dim Ok As Boolean
'On créer l'objet Excel
    Set xlApp = CreateObject("Excel.Application")
    'On défini le nombre d'onglets (ici 6)
    xlApp.SheetsInNewWorkbook = 6
    'On ajoute un classeur
    Set xlBook = xlApp.Workbooks.Add
    'On donne un nom au classeur
    xlBook.SaveAs ("Frais de")
    'On rend le classeur visible
    xlApp.Visible = True
    'On créer l'objet onglet dans le nouveau classeur créé
    Set xlSheet = xlBook.Worksheets(1)
    'On affecte un nom aux l'onglets
    xlSheet.Name = "OMO"
    'on libère l'objet onglet pour pouvoir en créer un nouveau ... etc
    Set xlSheet = Nothing
    Set xlSheet = xlBook.Worksheets(2)
    xlSheet.Name = "VRDI CANAL "
    Set xlSheet = Nothing
    Set xlSheet = xlBook.Worksheets(3)
    xlSheet.Name = "FOODS"
    Set xlSheet = Nothing
    Set xlSheet = xlBook.Worksheets(4)
    xlSheet.Name = "HARD SOAP"
    Set xlSheet = Nothing
    Set xlSheet = xlBook.Worksheets(5)
    xlSheet.Name = "TOILET SOAP"
    Set xlSheet = Nothing
    Set xlSheet = xlBook.Worksheets(6)
    xlSheet.Name = "PP"
    '
    '
    'On remet la propriété de l'application à 3 (par défaut)
    xlApp.SheetsInNewWorkbook = 3
    'On ferme l'application
    xlApp.Quit
    Set CL1 = Workbooks("Copy of Analyse des frais test")
    Set CL2 = Workbooks("Frais de")
    ListeACopier = Array("OMO", "VRDI CANAL ", "FOODS", "HARD SOAP", "TOILET SOAP", "PP")
    For Each LaFeuille In CL1.Worksheets
        For i = 0 To UBound(ListeACopier)
            Ok = Ok Or LaFeuille.Name = ListeACopier(i)
        Next
        If Ok Then LaFeuille.Copy
        Workbooks("Frais de").Worksheets(i).Range("A1").PasteSpecial Paste:=xlPasteValue, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Ok = False
    Next
    Set CL1 = Nothing
    Set CL2 = Nothing
End Sub

[YANN-56]

Bonsoir Kmario ou Bonjour suivant l'heure, et à ceux qui passeront par là.

Voici un truc dont j'utilise le principe:

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
Private Sub CommandButton1_Click()
 
ThisWorkbook.FollowHyperlink "C:\Documents and Settings\TOI\TON DOSSIER\Ton Classeur.xls" ' Chemin à Adapter
 
ActiveWorkbook.Worksheets("Page à Copier").Select ' Page à Préciser
 
ActiveSheet.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
 
 ' FERMETURE DU CLASSEUR SOURCE
 
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then
           ActiveWorkbook.Saved = True
           ActiveWorkbook.Close
    End If
 
End Sub

Bonne fin de journée.

P.S. Ton répertoire de destination est-il toujours le même,
ou souhaites-tu que l'utilisateur le choisisse?

Yann

[kmario]

Merci YANN c super mais j'avais utilisé une autre astuce en enregistrant mon classeur sous un autre nom et masquant les feuilles que je ne voulais pas. Encore THANKS