Copie des feuilles spécifiques dans un classeur existant [Résolu]

[breizhgen]

Bonjour,

je bloque sur une macro.

Je voudrais copier toutes les feuilles d'un classeur qui se situent entre deux feuilles distinctes, puis les copier sur le classeur qui déclenche la macro.

Mon problème réside dans le fait que le nombre de feuilles peut varier d'un classeur à un autre.

Exemple :

Mon classeur appelé se compose ainsi :

Feuille 1 : Toujours nommée Paramètres, elle détermine la première feuille du classeur, mais ne doit pas être importée

Feuille 2 : A importer
Feuille 3 : A importer
Feuille 4 : A importer
Feuille 5 : A importer
Feuille 6 : A importer
Feuille 7 : RECAP A à importer mais qui détermine la fin des feuilles
Feuille 8 : Inutile
Feuille 9 : Inutile
Feuille 10 : Inutile
....

A Noter que certaines feuilles de ce classeur sont masquées, je pense qu'il est impératif de les rendre visible avant l'import.

Merci à tous pour votre aide

David

[mercatog]

Code commenté

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
Sub Importer()
Dim Fichier As String, ShParam As String, ShRecap As String
Dim Wbk As Workbook
Dim Ws As Worksheet
Dim Deb As Boolean
 
Application.ScreenUpdating = False
'Chemin complet du fichier à importer
Fichier = "C:\Users\user\Desktop\Fichier2.xls"   'à adapter
'si le fichier existe
If Dir(Fichier) <> "" Then
    ShParam = "Paramètres"
    ShRecap = "RECAP"
    'On ouvre le fichier variable Wbk comporte ce fichier
    Set Wbk = Workbooks.Open(Fichier)
    'on parcours les feuilles du fichier Wbk
    For Each Ws In Wbk.Worksheets
        'on rend la feuille Ws visible
        Ws.Visible = True
        'Si le nom de la feuille est Paramètre, Deb sera vraie! on commence
        If Ws.Name = ShParam Then Deb = True
        'si Deb est vraie et le nom de la feuille est autre que Paramètre
        If Deb And Ws.Name <> ShParam Then
            'on copie la feuille à la fin de notre classeur
            Ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            'si on arrive à la feuille RECAP qui était déjà copiée, on arrête
            If Ws.Name = ShRecap Then Exit For
        End If
    Next Ws
    'on ferme le classeur Wbk sans sauvegarder
    Wbk.Close False
    'On écrase la variable Objet Wbk
    Set Wbk = Nothing
End If
End Sub

[breizhgen]

Bonjour Mercatog,

génial merci !!

En revanche, je souhaiterais que les feuilles soient insérées à la feuille après la 4é feuille.

J'ai donc modifié le code comme ça :

Code :

Ws.Copy After:=ThisWorkbook.Sheets(4)

Mais si les feuilles sont bien envoyées au bon endroit elles se retrouvent inversées. La RECAP se trouve en première position et les autres en suivant...

J'ai testé ton code sans modif et les feuilles sont dans le bon ordre.

Comment puis-je donc faire pour avoir mes feuilles dans le bon ordre et après la 4é feuille nommé BDD Situation ?

Merci encore pour ton aide

David

[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
Sub Importer()
Dim Deb As Integer, Fin As Integer, i As Integer
Dim Fichier As String
Dim Wbk As Workbook
Dim Ws As Worksheet
 
Application.ScreenUpdating = False
Fichier = "C:\Users\user\Desktop\Fichier2.xls"   'à adapter
If Dir(Fichier) <> "" Then
    Set Wbk = Workbooks.Open(Fichier)
    For Each Ws In Wbk.Sheets
        If Ws.Name = "Paramètres" Then Deb = Ws.Index
        If Ws.Name = "RECAP" Then
            Fin = Ws.Index
            Exit For
        End If
    Next Ws
    If Fin > Deb And Deb > 0 Then
        For i = Fin To Deb + 1 Step -1
            With Wbk.Sheets(i)
                .Visible = True
                .Copy After:=ThisWorkbook.Sheets(4)
            End With
        Next i
    End If
    Wbk.Close False
    Set Wbk = Nothing
End If
End Sub

[breizhgen]

Un énorme merci, tout fonctionne génial.

Bon week-end

David