Import d'onglets dans un seul fichier

Le 10/04/2015 à 10:38

Bonjour,

J'ai mis en place une macro qui me permet de créer des fichiers selon les onglets et ce grâce à cousinhub.

https://forum.excel-pratique.com/excel/macro-qui-cree-des-fichiers-selon-les-onglets-t63010.html

J'aimerai faire exactement l'inverse et reconstituer mon fichier avec l'ensemble des fichiers renseignés.

Mes fichiers portent un nom de famille et l’onglet du fichier se nomme de façon identique. l'idée est de récupérer les valeurs del'onglet et d'inclure dans mon fichier de synthèse.

J'ai essayé avec une macro de banzaï64, mais elle reprend les formules et cherche l’onglet feuil1 que je n'ai plus sur mes fichiers.

Option Explicit

Sub Importfiles()
Dim WbDest As Workbook, WbSource As Workbook
Dim WksNewSheet As Worksheet
Dim NomFichier As String, Chemin As String
Dim I As Long

  Set WbDest = ActiveWorkbook

  Chemin = "C:\PFT\Import\"
  NomFichier = Dir(Chemin & "*.xls") 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire

  Do While NomFichier <> ""                     'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
   Set WbSource = Workbooks.Open(Chemin & NomFichier)   'ouvre le fichier actuel à importer
   Set WksNewSheet = WbSource.Sheets("Feuil1") 'sélectionne la feuille de données à importer
   WksNewSheet.Activate                        'active cette feuille
   WksNewSheet.Select
    Range(Cells(1, 1), Cells(24, 24)).Select    'selection des données que l’on veut importer
   Selection.Copy                              'copie les données sélectionnées
   WbDest.Activate                             'retourne vers le fichier de départ
   I = ActiveSheet.UsedRange.Rows.Count        'compte le nombre de lignes déjà utilisées dans ce fichier
   Cells(I + 1, 1).Select                      'sélection de la cellule où on veut coller les données (la première vide)
   ActiveSheet.Paste                           'colle les données
   WbSource.Close                              'ferme le fichier source
   NomFichier = Dir                            'va vers le fichier suivant à importer
 Loop                                          'recommece la boucle avec le fichier suivant
 WbDest.Activate

End Sub

Si vous avez une idée ?

Cordialement,

Leakim

Le 10/04/2015 à 12:07

Bonjour Leakim, bonjour le forum,

Deux propositions à adapter (le nom de l'onglet destination WksDest) :

• Si l'onglet source est toujours le premier :

Sub Importfiles()
Dim WbDest As Workbook, WbSource As Workbook
Dim WksNewSheet As Worksheet
Dim WksDest As Worksheet
Dim NomFichier As String, Chemin As String
Dim I As Long
Dim DEST As Range

Set WbDest = ActiveWorkbook
Set WksDest = WbDest.Sheets(1) 'définit l'onglet de destination (à adapter à ton cas)
Chemin = "C:\PFT\Import\"
NomFichier = Dir(Chemin & "*.xls") 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire

Do While NomFichier <> ""                     'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
    Set WbSource = Workbooks.Open(Chemin & NomFichier)   'ouvre le fichier actuel à importer
    Set WksNewSheet = WbSource.Sheets(1) 'sélectionne la première feuille
    WksNewSheet.Range(Cells(1, 1), Cells(24, 24)).Copy                              'copie les données sélectionnées
    WbDest.Activate                             'retourne vers le fichier de départ
    Set DEST = WksDest.Cells(WksDest.UsedRange.Rows.Count + 1, 1)   'compte le nombre de lignes déjà utilisées dans ce fichier
    DEST.PasteSpecial (xlPasteValues) 'colle les données
    WbSource.Close                              'ferme le fichier source
    NomFichier = Dir                            'va vers le fichier suivant à importer
Loop                                          'recommece la boucle avec le fichier suivant
End Sub

• Si le nom de l'onget source n'est pas le premier mais a le même nom que le classeur (sans l'extension) :

Sub Importfiles()
Dim WbDest As Workbook, WbSource As Workbook
Dim WksNewSheet As Worksheet
Dim WksDest As Worksheet
Dim NomFichier As String, Chemin As String
Dim I As Long
Dim DEST As Range

Set WbDest = ActiveWorkbook
Set WksDest = WbDest.Sheets(1) 'définit l'onglet de destination (à adapter à ton cas)
Chemin = "C:\PFT\Import\"
NomFichier = Dir(Chemin & "*.xls") 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire

Do While NomFichier <> ""                     'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
    Set WbSource = Workbooks.Open(Chemin & NomFichier)   'ouvre le fichier actuel à importer
    Set WksNewSheet = WbSource.Sheets(Split(NomFichier, ".")()) 'sélectionne la feuille portant le même nom que le fichier
    WksNewSheet.Range(Cells(1, 1), Cells(24, 24)).Copy                              'copie les données sélectionnées
    WbDest.Activate                             'retourne vers le fichier de départ
    Set DEST = WksDest.Cells(WksDest.UsedRange.Rows.Count + 1, 1)   'compte le nombre de lignes déjà utilisées dans ce fichier
    DEST.PasteSpecial (xlPasteValues) 'colle les données
    WbSource.Close                              'ferme le fichier source
    NomFichier = Dir                            'va vers le fichier suivant à importer
Loop                                          'recommece la boucle avec le fichier suivant
End Sub
Le 10/04/2015 à 13:19

Bonjour tauthème, merci de ta sollicitude.

J'ai testé ton second code, qui correspond à ma demande (nom d'onglet le même que celui du fichier)

Pour autant j'ai un bug sur le nom de l'onglet ???

Je te mets le code avec le commentaires.

Sub Importfiles()
Dim WbDest As Workbook, WbSource As Workbook
Dim WksNewSheet As Worksheet
Dim WksDest As Worksheet
Dim NomFichier As String, Chemin As String
Dim I As Long
Dim DEST As Range

Set WbDest = ActiveWorkbook
Set WksDest = WbDest.Sheets(1) 'définit l'onglet de destination (à adapter à ton cas)
Chemin = "C:\Users\portable\Desktop\analyse temps\"
NomFichier = Dir(Chemin & "*.xlsm") 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire

Do While NomFichier <> ""                     'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
   Set WbSource = Workbooks.Open(Chemin & NomFichier)   'ouvre le fichier actuel à importer
   Set WksNewSheet = WbSource.Sheets(Split(NomFichier, "."))() 'sélectionne la feuille portant le même nom que le fichier Bug sur cette ligne.
   WksNewSheet.Range(Cells(1, 1), Cells(24, 24)).Copy       'copie les données sélectionnées, oui mais toute la feuille serait mieux
   WbDest.Activate                             'retourne vers le fichier de départ

   'Création d'un onglet au nom de celui de source et copie

   Set DEST = WksDest.Cells(WksDest.UsedRange.Rows.Count + 1, 1)   'compte le nombre de lignes déjà utilisées dans ce fichier
   'Pas forcément besoin de la ligne du dessus...enfin je crois ?

   DEST.PasteSpecial (xlPasteValues) 'colle les données
   WbSource.Close                              'ferme le fichier source
   NomFichier = Dir                            'va vers le fichier suivant à importer
Loop                                          'recommece la boucle avec le fichier suivant
End Sub

Merci encore,

Cordialement,

Leakim

Le 10/04/2015 à 13:29

Bonjour Leakim,

Essaie ainsi :

Set WksNewSheet = WbSource.Sheets(Split(NomFichier, ".")(0))
Le 10/04/2015 à 13:42

Bonjour Jean-Eric,

Correction validée, avec toute ma gratitude.

Reste que le code selectionne un zone et me colle à la suite le même onglet.

Que un onglet soit créer dans mon fichier de synthèse et que je retrouve les valeurs de mon fichier source.

Leakim

Le 10/04/2015 à 14:03

Re,

Modifie :

 WksNewSheet.Range(Cells(1, 1), Cells(24, 24)).Copy

par :

 WksNewSheet.Cells(1).CurrentRegion.Copy
Le 10/04/2015 à 21:24

Bonsoir,

Merci Jean-Eric pour ta proposition.

Cela fonctionne partiellement, puisque que les données se mettent toutes sur le même onglet...

Est ce que quelqu'un pourrait me mettre sur la piste afin que à chaque fichier soit créé un onglet qui se nomme de façon identique?

Je vous joins le code là où j'en suis.

Sub Importfiles()
Dim WbDest As Workbook, WbSource As Workbook
Dim WksNewSheet As Worksheet
Dim WksDest As Worksheet
Dim NomFichier As String, Chemin As String
Dim I As Long
Dim DEST As Range

Set WbDest = ActiveWorkbook
                                      'définit l'onglet de destination (à adapter à ton cas)
Chemin = "C:\Users\portable\Desktop\analyse temps\"
NomFichier = Dir(Chemin & "*.xlsm")                                 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire

Set WksDest = WbDest.Sheets(1)  '(Split(NomFichier, ".")(0))

Do While NomFichier <> ""                                           'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
   Set WbSource = Workbooks.Open(Chemin & NomFichier)               'ouvre le fichier actuel à importer
   Set WksNewSheet = WbSource.Sheets(Split(NomFichier, ".")(0))     'sélectionne la feuille portant le même nom que le fichier
   WksNewSheet.Unprotect
   WksNewSheet.Cells(1).CurrentRegion.Copy                          'copie les données sélectionnées, oui mais toute la feuille serait mieux
   WbDest.Activate                                                  'retourne vers le fichier de départ

   'Création d'un onglet au nom de celui de source et copie

   Set DEST = WksDest.Cells(WksDest.UsedRange.Rows.Count + 1, 1)    'compte le nombre de lignes déjà utilisées dans ce fichier
   'Pas forcément besoin de la ligne du dessus...

   DEST.PasteSpecial (xlPasteValues)                                'colle les données
   WbSource.Close                                                   'ferme le fichier source
   NomFichier = Dir                                                 'va vers le fichier suivant à importer
Loop                                                                'recommece la boucle avec le fichier suivant
End Sub

D'avance merci,

Leakim

Le 11/04/2015 à 10:14

Bonjour,

Si j'ai bien compris la demande :

Cdlt.

Option Explicit

Public Sub ImportFiles()
Dim wbDest As Workbook, wbSource As Workbook
Dim wsDest As Worksheet, wsSource As Worksheet
Dim myFile As String, myPath As String

    Application.ScreenUpdating = False
    Set wbDest = ThisWorkbook
    Set wsDest = wbDest.Worksheets(1)
    myPath = "C:\Users\portable\Desktop\analyse temps\"
    myFile = Dir(myPath & "*.xlsm")

    Do While myFile <> ""
        Set wbSource = Workbooks.Open(myPath & myFile)
        Set wsSource = wbSource.Worksheets(Split(myFile, "."))(0)
        wsSource.Range(Cells(1, 1), Cells(24, 24)).Copy
        With wbDest
            .Worksheets.Add After:=Worksheets(Worksheets.Count)
            .Cells(1).PasteSpecial (xlPasteValues)    'Or xlPasteValuesAndNumberFormats
            If IsError(Evaluate("=" & wsSource.Name & "!A1")) Then
                ' si la feuille n'existe pas
                .ActiveSheet.Name = wsSource.Name
            Else
                .ActiveSheet.Name = "xxx_" & wsSource.Name
            End If
        End With
        wbSource.Close
        myFile = Dir
    Loop

    Set wsDest = Nothing: Set wsSource = Nothing
    Set wbDest = Nothing: Set wbSource = Nothing

End Sub
Le 11/04/2015 à 14:43

Bonjour,

Merci Jean-Eric,

Nous y sommes presque. Voici le code que j'ai mis, j'ai un bug au moment de coller , la création d'onglet en reprenant le nom c'est nickel ! Par contre les onglets sont vierges...

Public Sub ImportFiles()
Dim wbDest As Workbook, wbSource As Workbook
Dim wsDest As Worksheet, wsSource As Worksheet
Dim myFile As String, myPath As String

    Application.ScreenUpdating = False
    Set wbDest = ThisWorkbook
    Set wsDest = wbDest.Worksheets(1)
    myPath = "C:\Users\portable\Desktop\analyse temps\"
    myFile = Dir(myPath & "*.xlsm")

    Do While myFile <> ""
        Set wbSource = Workbooks.Open(myPath & myFile)
        Set wsSource = wbSource.Worksheets(Split(myFile, ".")(0))
            wsSource.Unprotect
            wsSource.Cells(1).CurrentRegion.Copy

        'wsSource.Range(Cells(1, 1), Cells(24, 24)).Copy
        With wbDest
            .Worksheets.Add After:=Worksheets(Worksheets.Count)
            '.Cells(1).PasteSpecial(xlPasteValuesAndNumberFormats)   'Or  xlPasteValues
           If IsError(Evaluate("=" & wsSource.Name & "!A1")) Then
                ' si la feuille n'existe pas
               .ActiveSheet.Name = wsSource.Name
            Else
                .ActiveSheet.Name = wsSource.Name
            End If
        End With
        wbSource.Close
        myFile = Dir
    Loop

    Set wsDest = Nothing: Set wsSource = Nothing
    Set wbDest = Nothing: Set wbSource = Nothing

End Sub

Avis au VBAiste.

Cordialement,

Leakim

Le 11/04/2015 à 17:34

Re,

Si on admet que le classeur de destination ne comporte aucune feuille. 

Option Explicit
Public Sub ImportFiles()
Dim wbDest As Workbook, wbSource As Workbook
Dim wsDest As Worksheet, wsSource As Worksheet
Dim myFile As String, myPath As String

    Application.ScreenUpdating = False
    Set wbDest = ThisWorkbook
    Set wsDest = wbDest.Worksheets(1)
    myPath = "C:\Users\portable\Desktop\analyse temps\"
    myFile = Dir(myPath & "*.xlsm")

    Do While myFile <> ""
        Set wbSource = Workbooks.Open(myPath & myFile)
        Set wsSource = wbSource.Worksheets(Split(myFile, ".")(0))
        wsSource.Copy after:=wbDest.Worksheets(1)
        wbSource.Close
        myFile = Dir
    Loop

    Set wsDest = Nothing: Set wsSource = Nothing
    Set wbDest = Nothing: Set wbSource = Nothing

End Sub
Le 11/04/2015 à 23:20

Bonsoir Jean-Eric,

On y est ! C'est juste nickel, en plus le code est simplifié.

Merci pour ton abnégation .

Leakim

Rechercher des sujets similaires à "import onglets seul fichier"