VBA Excel: Importer des feuilles vers un classeur

Résolu/Fermé
Amélie - 20 févr. 2015 à 10:33
cs_Le Pivert
Messages postés
7752
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 mai 2022
- 23 févr. 2015 à 17:56
Bonjour,

Je cherche un code fiable me permettant d'importer les feuilles d'un classeur à un autre.
Concrètement, en ouvrant le classeur contenant la macro puis en appuyant sur un bouton, j'aimerais pouvoir récupérer toutes les feuilles d'un classeur à choisir mais situé dans le même répertoire.
Est-ce que quelqu'un saurait faire?

Merci!
A voir également:

2 réponses

cs_Le Pivert
Messages postés
7752
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 mai 2022
711
20 févr. 2015 à 16:33
Faire alt f11 pour accéder à l'éditeur
Insérer un UserForm
Mettre un bouton avec ce code



Option Explicit
Private Sub CommandButton1_Click()
 Dim i As Integer
 Dim nom As String
    Workbooks.Open ThisWorkbook.Path & "\" & "Classeur1.xls" 'classeur à copier a adapter le nom
 'on parcourt toutes les feuilles
 For i = 1 To Worksheets.Count
 Workbooks("Classeur1.xls").Activate 'classeur à copier a adapter le nom
nom = Worksheets(i).Name
Sheets(nom).Select
 Sheets(nom).Copy after:=Workbooks("Copier_onglet.xls").Sheets(1) 'classeur à coller a adapter le nom
Next
End Sub


9
Bonjour,

Et merci pour la réponse! Après avoir essayé le code, je peux affirmer qu'il fonctionne parfaitement! Les onglets n'arrivent pas dans le même ordre, mais ça n'est pas important, l'essentiel y est.

Merci encore!
0
cs_Le Pivert
Messages postés
7752
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 mai 2022
711
21 févr. 2015 à 08:35
Oui je m'en suis aperçu et j'ai rectifié.
J'ai ajouté l'effacement des onglets au cas ou.
il faudra ajouter un bouton.
Voici le code:

Option Explicit
Private Sub CommandButton1_Click()
 Dim i As Integer
 Dim nom As String
    Workbooks.Open ThisWorkbook.Path & "\" & "Classeur1.xls" 'classeur à copier a adapter le nom
 'on parcourt toutes les feuilles
 For i = 1 To Worksheets.Count
 Workbooks("Classeur1.xls").Activate 'classeur à copier a adapter le nom
nom = Worksheets(i).Name
Sheets(nom).Select
 Sheets(nom).Copy After:=Workbooks("Copier_onglet.xls").Sheets(1) 'classeur à coller a adapter le nom
Sheets(nom).Move After:=Sheets(Sheets.Count) 'on met les onglets dans l'ordre
Next
End Sub
Private Sub CommandButton2_Click()
 Sheets("Recapitulatif").Select
EffacementTouteFeuille
End Sub
Sub EffacementTouteFeuille()
   Dim Ctr
   Application.DisplayAlerts = False
   For Ctr = Sheets.Count To 1 Step -1
     If Sheets(Ctr).Name <> ActiveSheet.Name Then
       Sheets(Ctr).Delete
     End If
   Next
     Application.DisplayAlerts = True
 End Sub
Private Sub UserForm_Initialize()
CommandButton1.Caption = "Copier feuilles"
CommandButton2.Caption = "Supprimer feuilles"
End Sub


Bon WE
@+ Le Pivert
0
cs_Le Pivert
Messages postés
7752
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 mai 2022
711
21 févr. 2015 à 09:08
On peut copier en partant de la dernière feuille et remonter comme ceci:

Private Sub CommandButton1_Click()
 Dim i As Integer
 Dim nom As String
    Workbooks.Open ThisWorkbook.Path & "\" & "Classeur1.xls" 'classeur à copier a adapter le nom
 'on parcourt toutes les feuilles
 For i = Sheets.Count To 1 Step -1
 Workbooks("Classeur1.xls").Activate 'classeur à copier a adapter le nom
nom = Worksheets(i).Name
Sheets(nom).Select
 Sheets(nom).Copy After:=Workbooks("Copier_onglet.xls")coller a adapter le nom
Next
End Sub


C'est la manière la plus logique!
0
Amélie > cs_Le Pivert
Messages postés
7752
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 mai 2022

23 févr. 2015 à 09:01
Bonjour,

le code transmis à 8h35 fonctionne parfaitement, ajustant même l'ordre des feuilles, il convient parfaitement!
En revanche, celui de 9h08 entraîne un message d'erreur, que j'ai pu corriger en comparant le code avec le précédent: en effet, la ligne 10 doit être rectifiée ainsi:
Sheets(nom).Copy After:=Workbooks("Copier_onglet.xls").Sheets(1) 'classeur à coller a adapter le nom

Ce qui correspond tout simplement à la ligne 11 du code de 8h35.
Pour le reste, rien à dire, merci encore!
0
Re,

Question annexe: j'ai modifié le code de façon à ce que le nom du classeur contenant la macro soit automatiquement renseigné:
Private Sub CommandButton1_Click()
Dim i As Integer
Dim nom As String
Dim Nomdececlasseur As String
Application.DisplayAlerts = False
Workbooks.Open ThisWorkbook.Path & "\" & "Classeur1.xls" 'classeur à copier a adapter le nom
'on parcourt toutes les feuilles
For i = 1 To Worksheets.Count
Workbooks("Classeur1.xls").Activate 'classeur à copier a adapter le nom
nom = Worksheets(i).Name
Nomdececlasseur = ThisWorkbook.Name
Sheets(nom).Select
Sheets(nom).Copy After:=Workbooks(Nomdececlasseur).Sheets(1) 'classeur à coller a adapter le nom
Sheets(nom).Move After:=Sheets(Sheets.Count) 'on met les onglets dans l'ordre
Next
Workbooks(Nomdececlasseur).Sheets(1).Activate
Application.DisplayAlerts = True
End Sub

J'aimerais à présent savoir comment faire pour que le nom du classeur à copier se renseigne automatiquement après l'avoir choisi dans une boîte de dialogue ouvrant le répertoire dans lequel se trouvent les deux documents, autrement dit, sans avoir à passer par le développeur?

Merci
0