Macro Importation de fichier avec leurs onglets

  • Initiateur de la discussion Initiateur de la discussion Soleil11
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Soleil11

XLDnaute Occasionnel
Bonjour le forum,

J'utilise la macro ci-dessous pour importer plusieurs fichiers.xls avec la feuille 1 dans un même et seul fichier de consolidation . J'aimerais modifier cette macro afin qu'elle puisse importer aussi toutes les feuilles de chaque fichier xls. Actuellement, elle l'importe que la feuille 1. de chaque fichier.

Pourriez-vous m'aider à modifier ce code ou peut-être existe-t-il une autre méthode ?

Code:
Sub Import_Files2()

Dim Ligne As Long, Lig As Long

Dim tabStr() As String

Dim v_path$

Dim ws As Worksheet, wbk As Workbook, Temp$, Rep$, Fic$
Set ws = ThisWorkbook.Sheets(1) '       <- Feuille de copie des données
Worksheets("Macrodata").Activate
v_path$ = Sheets("Macrodata").Range("G7")
MsgBox ("From path: '" & v_path$ & "'")
Rep = v_path$ & "\": Fic = "*.xls" '      <-Désignation du dossier/type de fichier
Temp = Dir(Rep & Fic) '                 <- ici on parcourt le dossier
Application.ScreenUpdating = False '    <- ici on fige l'écran
    Do While Temp <> ""
             
            Set wbk = Workbooks.Open(Rep & Temp) '<- ici on ouvre le classeur trouvé
        
             For Each Sheet In wbk.Sheets
             
              Lig = wbk.Sheets(1).UsedRange.Rows.Count
                              
                 Ligne = ws.[A65536].End(xlUp).Row
                
                 With ThisWorkbook
        
                Sheets(1).Copy after:=.Sheets(.Sheets.Count) 'copie les feuilles et leur noms
                                                    
                End With
             wbk.Close '<- fermeture du classeur
             Next Sheet
        
      
    Temp = Dir
    Loop


Set wbk = Nothing '<- reset variable WBk
Application.ScreenUpdating = True '<- ici on défige l'écran
End Sub

Merci d'avance pour votre aide.

Soleil11:😕
 
Re : Macro Importation de fichier avec leurs onglets

Salut Soleil11,

Le problème est que tu fais référence à Sheets(1) dans ton code.

Voici une proposition (non testée), ça pourra t'aider à compléter j'espère :

Code:
Do While Temp <> ""
             
            Set wbk = Workbooks.Open(Rep & Temp) '<- ici on ouvre le classeur trouvé
            For i = 1 to wbk.sheets.count
             
              Lig = wbk.Sheets(i).UsedRange.Rows.Count   ' ???????      
              Ligne = ws.[A65536].End(xlUp).Row   ' ?????? 
                
                With ThisWorkbook
        
                wbk.Sheets(i).Copy after:=.Sheets(.Sheets.Count) 'copie les feuilles et leur noms
                                                    
                End With
             Next i 
             wbk.Close '<- fermeture du classeur
         
      
    Temp = Dir
    Loop
 
Re : Macro Importation de fichier avec leurs onglets

Bonjour Soleil11,

Peut-être

Code:
Sub Import_Files2()

Dim Ligne As Long, Lig As Long

Dim tabStr() As String

Dim v_path$, sht As Worksheet

Dim ws As Worksheet, wbk As Workbook, Temp$, Rep$, Fic$
Set ws = ThisWorkbook.Sheets(1) '       <- Feuille de copie des données
Worksheets("Macrodata").Activate
v_path$ = Sheets("Macrodata").Range("G7")
MsgBox ("From path: '" & v_path$ & "'")
Rep = v_path$ & "\": Fic = "*.xls" '      <-Désignation du dossier/type de fichier
Temp = Dir(Rep & Fic) '                 <- ici on parcourt le dossier
Application.ScreenUpdating = False '    <- ici on fige l'écran
    Do While Temp <> ""
             
            Set wbk = Workbooks.Open(Rep & Temp) '<- ici on ouvre le classeur trouvé
       
             For Each sht In wbk.Sheets
               
                 With ThisWorkbook
       
                sht.Copy after:=.Sheets(.Sheets.Count) 'copie les feuilles et leur noms
                                                   
                End With
             wbk.Close '<- fermeture du classeur
             Next Sheet
       
     
    Temp = Dir
    Loop


Set wbk = Nothing '<- reset variable WBk
Application.ScreenUpdating = True '<- ici on défige l'écran
End Sub
J'ai viré les bouts de code qui ne servaient à rien mais peut-être que c'était une erreur... Si ce n'est pas une erreur, on pourra aussi faire le ménage dans les variables déclarées...

Edit : Bonjour Grand Chaman
 
Dernière édition:
Re : Macro Importation de fichier avec leurs onglets

Bonjour Soleil11,

Peut-être

Code:
Sub Import_Files2()

Dim Ligne As Long, Lig As Long

Dim tabStr() As String

Dim v_path$, sht As Worksheet

Dim ws As Worksheet, wbk As Workbook, Temp$, Rep$, Fic$
Set ws = ThisWorkbook.Sheets(1) '       <- Feuille de copie des données
Worksheets("Macrodata").Activate
v_path$ = Sheets("Macrodata").Range("G7")
MsgBox ("From path: '" & v_path$ & "'")
Rep = v_path$ & "\": Fic = "*.xls" '      <-Désignation du dossier/type de fichier
Temp = Dir(Rep & Fic) '                 <- ici on parcourt le dossier
Application.ScreenUpdating = False '    <- ici on fige l'écran
    Do While Temp <> ""
             
            Set wbk = Workbooks.Open(Rep & Temp) '<- ici on ouvre le classeur trouvé
       
             For Each sht In wbk.Sheets
               
                 With ThisWorkbook
       
                sht.Copy after:=.Sheets(.Sheets.Count) 'copie les feuilles et leur noms
                                                   
                End With
             wbk.Close '<- fermeture du classeur
             Next Sheet
       
     
    Temp = Dir
    Loop


Set wbk = Nothing '<- reset variable WBk
Application.ScreenUpdating = True '<- ici on défige l'écran
End Sub
J'ai viré les bouts de code qui ne servaient à rien mais peut-être que c'était une erreur... Si ce n'est pas une erreur, on pourra aussi faire le ménage dans les variables déclarées...

Edit : Bonjour Grand Chaman


Bonjour,

Vos deux propositions fonctionnent parfaitement, encore un dernier petit service est-il possible d'importer que les feuilles qui sont visibles celles qui sont cachées ne m'intéressent pas.

Merci encore de votre précieuse aide.

Soleil11😛
 
Re : Macro Importation de fichier avec leurs onglets

Bonjour Soleil11,

Code:
             For Each sht In wbk.Sheets
               
                 With ThisWorkbook
       
                if sht.Visible = xlsheetvisible then sht.Copy after:=.Sheets(.Sheets.Count) 'copie les feuilles et leur noms
                                                   
                End With
             wbk.Close '<- fermeture du classeur
             Next Sheet
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Erreur de macro
Réponses
4
Affichages
742
Retour