Fusion fichier

[excelo]

bonjour ou plutôt bonsoir à tous,
je sais bien que le problème a été posé maint et maint fois sur le forum et que la solution s'y trouve mais je n'arrive pas à l'adapter à mon problème. j'essaie d'apprendre en VBA mais j'avoue que j'ai du mal!, alors je fais appel à votre aide,
j'essaie de fusionner mes tableaux excel (formats identiques) sur une même feuille.
Petit Bémol : à partir du 2ème tableau il faudrait prendre les informations à partir de la 4ème ligne.
précision peut être utile : les feuilles à fusionner ont le même nom
je vous joint un exemple, merci d'avance pour votre aide

 

[mromain]

Re : Fusion fichier

bonjour excelo,

à tester...

a+

 

[excelo]

Re : Fusion fichier

Merci mromain pour ta solution, qui marche trés bien, ceci dit j'ai quelques réglages à faire pour l'adapter sur mes fichiers d'origine, je l'ai pas précisé parce que je voulais faire cours mais mes tableaux comportent des colonnes allant de A à AG et chaque fichier comporte plusieurs classeur. le classeur à fusionner pour chaqun des fichiers est nommé "variables de paies". je sais pas si c'est important de le préciser ou pas.
je réfléchi sur le problème ce soir car je suis en plein boulot et je sais pas faire plusieurs choses à la fois ;-) je reviens vers vous ce soir pour vous dire ce qu'il en est. bonne journée à tous

 

[mromain]

Re : Fusion fichier

re,

tu auras la macro "ImportFichiers" à modifier.
je te la remet un peu plus commentée :

Public Sub ImportFichiers()
Dim fichiersImport
Dim classeurCourant As Workbook
Dim iFichier As Integer
Dim feuilleImport As Worksheet
Dim zoneCopie As Range, zoneColle As Range

'définir la feuille d'import (elle doit déjà avoir les 3 lignes d'entêtes complétées)
Set feuilleImport = ThisWorkbook.Sheets("Feuille Import")

'récupérer les fichiers à ouvrir
fichiersImport = Application.GetOpenFilename("Fichiers Excel, *.xls; *.xlsx; *.xlsm", , "Sélectionnez les fichiers à importer", , True)

'boucler sur chaque classeurs
For iFichier = LBound(fichiersImport) To UBound(fichiersImport)
    'ouvrir le classeur
    Set classeurCourant = Application.Workbooks.Open(fichiersImport(iFichier), , True)

    'remplacer "Feuil1" par le nom de la feuille à copier
    With classeurCourant.Sheets("Feuil1")
        
        'récupérer la zone à copier
        Set zoneCopie = .Range("A3").CurrentRegion
        Set zoneCopie = zoneCopie.Resize(zoneCopie.Rows.Count - 3, zoneCopie.Columns.Count).Offset(3)
        
        'récupérer la zone où coller le contenu
        Set zoneColle = feuilleImport.Range("A3").CurrentRegion
        Set zoneColle = zoneColle.Offset(zoneColle.Rows.Count).Resize(1, 1)
        
        'copier
        zoneCopie.Copy zoneColle
        
        'rajouter sur la colonne de droite le nom du fichier et fusionner les cellules
        'remplacer les "F" par la colonne correspondante
        feuilleImport.Range("F" & zoneColle.Row).Value = NomDuFichier(CStr(fichiersImport(iFichier)))
        feuilleImport.Range("F" & zoneColle.Row & ":F" & zoneColle.Row + zoneCopie.Rows.Count - 1).MergeCells = True
        'mettre en forme les cellules fusionnées
        MiseEnFormeCelluleColF feuilleImport.Range("F" & zoneColle.Row & ":F" & zoneColle.Row + zoneCopie.Rows.Count - 1)
    End With
    'fermer le classeur
    classeurCourant.Close
Next iFichier
End Sub

a+

 

[excelo]

Re : Fusion fichier

Merci mromain pour toutes ces precisions, j'ai modifié toutes les informations comme indiqué sur tes explications mais j'ai un Debogage qui viens de là :

Sub MiseEnFormeCelluleColF(cellule As Range)
With cellule.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0 "Debogage
.PatternTintAndShade = 0
End With
With cellule
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With cellule.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 1
.TintAndShade = 0
.Weight = xlMedium
End With
With cellule.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 1
.TintAndShade = 0
.Weight = xlMedium
End With
With cellule.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 1
.TintAndShade = 0
.Weight = xlMedium
End With
With cellule.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 1
.TintAndShade = 0
.Weight = xlMedium
End With
End Sub

Merci pour ton aide mromain

 

[mromain]

Re : Fusion fichier

re,

cette macro a été écrite avec l'enregistreur... depuis Excel2007
essaye en enlevant les lignes où il y a "TintAndShade"

a+

 

[excelo]

Re : Fusion fichier

j'ai supprimé les lignes où il y a "TintAndShade" et j'ai eu d'autres debogages, alors j'ai trifouillé les codes et j'ai du faire des modifications que j'aurai peut être pas du. je crois que le plus simple serait que tu visualises les fichiers originaux, merci mromain pour ton aide, bon appétit pour ceux ou celles qui n'auraient pas mangé ;-)

 

[mromain]

Re : Fusion fichier

re,

les fichiers que tu as souhaite importer ont moins de colonnes que le résultat souhaité, du coup, ce n'est pas qu'un simple copier-coller de la ligne.
le mieux serait que les colonnes de ton résultat souhaité soient les mêmes que les fichier à importer (toujours pour le copier-coller de la ligne).

a+

 

[excelo]

Re : Fusion fichier

Merci pour ta réponse mromain,
peut on procéder autrement qu'en faisant du copier/coller ou est-il possible d'adapter le nombre de colonnes à importer au résultat souhaité de A à AZ par exemple?

 

[mromain]

Re : Fusion fichier

re,

il vaut mieux (a mon avis) adapter les fichiers à importer et faire des copier/coller de lignes entières.
après, je t'avoue que je n'ai pas compris grand chose à tes tableau...
je pense que tu est le mieux placé pour "adapter le nombre de colonnes à importer au résultat souhaité".
je t'aiderai alors à adapter la macro "d'import".

a+

 

[excelo]

Re : Fusion fichier

ok merci mromain, je regarderai ce soir plus tranquillement et je me rapprocherai de toi si tu veux bien pour des explications eventuelles, merci ;-)

 

[excelo]

Re : Fusion fichier

je viens aux nouvelles, j'ai pu modifié le code de manière à pouvoir acoller mes tableaux l'un aprés l'autre, j'ai supprimé le nom du fichier de la colonne F, en fait j'en avais pas besoin, du coup j'ai modifié le code de cette façon :

Public Sub ImportFichiers()
Dim fichiersImport
Dim classeurCourant As Workbook
Dim iFichier As Integer
Dim feuilleImport As Worksheet
Dim zoneCopie As Range, zoneColle As Range

Set feuilleImport = ThisWorkbook.Sheets("Feuille Import")

fichiersImport = Application.GetOpenFilename("Fichiers Excel, *.xls; *.xlsx; *.xlsm", , "Sélectionnez les fichiers à importer", , True)

For iFichier = LBound(fichiersImport) To UBound(fichiersImport)
Set classeurCourant = Application.Workbooks.Open(fichiersImport(iFichier), , True)
With classeurCourant.Sheets("variables de paies")
Set zoneColle = feuilleImport.Range("A3").CurrentRegion
Set zoneColle = zoneColle.Offset(zoneColle.Rows.Count).Resize(1, 1)
Set zoneCopie = .Range("A3").CurrentRegion
Set zoneCopie = zoneCopie.Resize(zoneCopie.Rows.Count - 3, zoneCopie.Columns.Count).Offset(3)
zoneCopie.Copy zoneColle


End With
classeurCourant.Close
Next iFichier
End Sub

et là ça marche trés bien, merci beaucoup pour ton aide mromain ;-)

 

[MJ13]

Re : Fusion fichier

Bonjour à tous

Merci à vous deux pour cet excellent travail . Pour le retrouver j'ai mis en recherche avancée: fusion fichier dans le titre.

J'en avais besoin pour fusionner des fichiers et voici mon code issu du dernier code de Excelo.

Il permet de regrouper des fichiers ayant pour nom en feuille "Feuille de Calcul1" de A1 à Colonne Zfin:

Le code est facilement adaptable:

Public Sub ImportFichiers()
Dim fichiersImport
Dim classeurCourant As Workbook
Dim iFichier As Integer
Dim feuilleImport As Worksheet
Dim zoneCopie As Range, zoneColle As Range

Set feuilleImport = ThisWorkbook.Sheets("Feuille Import")

fichiersImport = Application.GetOpenFilename("Fichiers Excel, *.xls; *.xlsx; *.xlsm", , "Sélectionnez les fichiers à importer", , True)

For iFichier = LBound(fichiersImport) To UBound(fichiersImport)
Stop
Set classeurCourant = Application.Workbooks.Open(fichiersImport(iFichier), , True)
With classeurCourant.Sheets("Feuille de Calcul1")

'Set zoneColle = feuilleImport.Range("A1:A4").CurrentRegion
Set zoneColle = ThisWorkbook.Sheets("Feuille Import").Range("A" & ThisWorkbook.Sheets("Feuille Import").Range("A65536").End(xlUp).Row + 1)
'Set zoneColle = zoneColle.Offset(zoneColle.Rows.Count).Resize(1, 1)
'Set zoneCopie = .Range("A1:A4").CurrentRegion
Set zoneCopie = .Range("A1:Z" & Range("A65536").End(xlUp).Row)

'Set zoneCopie = zoneCopie.Resize(zoneCopie.Rows.Count - 3, zoneCopie.Columns.Count).Offset(3)
zoneCopie.Copy zoneColle

End With
classeurCourant.Close
Next iFichier
End Sub