VBA Excel: Importer des feuilles vers un classeur
Résolu
Amélie
-
cs_Le Pivert Messages postés 8437 Statut Contributeur -
cs_Le Pivert Messages postés 8437 Statut Contributeur -
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!
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!
2 réponses
-
Faire alt f11 pour accéder à l'éditeur
Insérer un UserForm
Mettre un bouton avec ce codeOption 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
-
-
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
-
