Fusion de plusieurs fichiers excel

Y compris Power BI, Power Query et toute autre question en lien avec Excel
s
seb8791
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 5 décembre 2016
Version d'Excel : 2013

Message par seb8791 » 2 février 2017, 01:38

Bonjour à tous,

J'ai déjà vu des sujets à ce sujet mais aucune macro ne semble fonctionner ou en tout cas ne fonctionne pas pour mon cas qui me semblait simple.

Je possède 90 fichiers (xlsx) qui ont parfois plusieurs feuilles.

J'aimerais tous les combiner dans un seul fichier excel nouveau.

Par ailleurs, j'aimerais une autre macro pour regrouper sur une meme feuille toutes les données Excel d'un classeur à plusieurs feuilles.

Quelqu'un aurait il ces deux macro magique ?

Merci par avance,
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'019
Appréciations reçues : 306
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 2 février 2017, 07:15

Bonjour,

Teste ceci concernant ta seconde question :
Sub Regrouper()
    
    Dim FeRecap As Worksheet
    Dim Fe As Worksheet
    Dim LaPlage As Range
    Dim Lg As Long
    
    'la feuille qui récupére les valeurs se nomme "Recap", à adapter...
    Set FeRecap = Worksheets("Recap")
    
    'parcour de la collection :
    For Each Fe In Worksheets
        
        'évite de prendre en compte la feuille Recap
        If Fe.Name <> FeRecap.Name Then
            
            'défini la plage à récupérer
            Set LaPlage = Plage(Fe)
            
            'si existe...
            If Not LaPlage Is Nothing Then
                
                'recherche la dernière ligne non vide de la feuille Recap puis décale vers le bas, si la feuille est vierge, lg=1
                If Not Plage(FeRecap) Is Nothing Then Lg = Plage(FeRecap).Rows.Count + 1 Else Lg = 1
                
                'inscription des valeurs
                With FeRecap
                    .Range(.Cells(Lg, 1), .Cells(LaPlage.Rows.Count + Lg - 1, LaPlage.Columns.Count)).Value = LaPlage.Value
                End With
                
            End If
            
            
        End If
        
    Next Fe
    
End Sub

Function Plage(Fe As Worksheet) As Range
    
    On Error GoTo Fin
    
    With Fe

        Set Plage = .Range(.Cells(1, 1), _
                    .Cells(.Cells.Find("*", .[A1], -4123, , _
                    1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                    2, 2).Column))

    End With
    
    Exit Function
    
Fin:

    Set Plage = Nothing

End Function
Je regarde pour la première !
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'019
Appréciations reçues : 306
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 2 février 2017, 07:32

Re,

Pour la récup des classeurs :
Sub Consolider()
    
    Dim Cls As Workbook
    Dim Fe As Worksheet
    Dim Tablo() As String
    Dim Chemin As String
    Dim I As Integer
    
    Chemin = "C:\Mon Dossier\"
    
    'appel de la fonction avec le chemin du dossier (adapter...)
    Tablo = RecupFichiers(Chemin)
    
    'si au moins un fichier trouvé...
    If Not (Not Tablo) Then
    
        For I = 1 To UBound(Tablo)
    
            'ouvre le classeur...
            Set Cls = Workbooks.Open(Chemin & Tablo(I))
    
            'parcours sa collection de feuilles...
            For Each Fe In Cls.Worksheets
    
                'c'est ici qu'il te faut savoir quoi faire ?..
                'pour le test, inscrit le nom des feuilles dans la fenêtre d'exécution (Ctrl+G)
                Debug.Print Fe.Name
    
    
            Next Fe
    
            'referme le classeur
            Cls.Close False
    
        Next I
    
    End If

End Sub

Function RecupFichiers(Chemin As String) As String()

    Dim Tbl() As String
    Dim Fichier As String
    Dim I As Integer
    
    'seulement les fichiers .xlsx
    Fichier = Dir(Chemin & "*.xlsx")
    
    Do While (Len(Fichier) > 0)
    
        I = I + 1
        ReDim Preserve Tbl(1 To I)
        Tbl(I) = Fichier
        Fichier = Dir()
        
    Loop
    
    RecupFichiers = Tbl()
    
End Function
il te faut savoir quoi faire, les feuilles doivent être ajoutées au nouveau classeur ? Une seule feuille qui regroupe les valeurs des autres feuilles du même classeur ?
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message