Macro Importation de fichier avec leurs onglets

[Soleil11]

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 ?

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:😕

 

[Grand Chaman Excel]

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 :

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

 

[tototiti2008]

Re : Macro Importation de fichier avec leurs onglets

Bonjour Soleil11,

Peut-être

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

 

[Soleil11]

Re : Macro Importation de fichier avec leurs onglets

Bonjour Soleil11,

Peut-être

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😛

 

[tototiti2008]

Re : Macro Importation de fichier avec leurs onglets

Bonjour Soleil11,

             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

 

[Soleil11]

Re : Macro Importation de fichier avec leurs onglets

Merci à tout les membres du forum,

C'est tout a fait ce qu'il me faut, je vous remercie pour toute l'aide que vous m'avez apportée.

Soleil11.