Fusion de plusieurs fichiers Excel

Bonjour,

Je souhaiterais fusionner plusieurs fichiers excel en reportant dans un unique tableau les réponses aux questions posées.

Si cela est utile : tous les formulaires contenant les réponses seront dans un même dossier.

Ci-joint le formulaire de base qui sera fusionné.

Je n'ai pas de format spécifique pour la centralisation. Dans l'idéal j'aurai mis les questions en tête de colonnes et ensuite si la macro remplie ligne par ligne (1 ligne = 1 formulaire) çà me va !

Merci d'avance de votre aide !

Natacha

Bonsoir

voici une proposition

tous les fichiers du sondage doivent être dans un dossier et uniquement cela

le fichier joint doit être ailleurs ou tu veux mais ailleurs, tu trouveras le tiens que j'ai complété pour faire un essai

a chaque lancement il ya effacement des données présentent sur la feuille pour récupérer que les info des fichiers dans le dossier spécifique.

si tu veux faire des sous dossier pour un classement par exemple c'est possible faudra enlever quelques lignes qui sont en commentaires.

bon essais

Fred

94natou.xlsm (18.77 Ko)

Bonsoir le fil, bonsoir le forum,

Arf ! Fred a été plus rapide... J'envoie quand même une autre proposition dont le principe est un peu différent. Contrairement à Fred, ce fichier doit se trouver dans le même dossier que les fichiers de questionnaire.

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CH As String 'déclare la variable CH (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim J As Integer 'déclare la variable J (incrément)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TC As Variant 'déclare la variable TC (Tableau de cellules)
Dim TL() As Variant ''déclare la variable TL (Tableau de Lignes)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Sheets("Feuil1") 'définit l'onglet destination OD
OD.Range("A1").CurrentRegion.Offset(2, 0).ClearContents 'efface d'éventuelle anciennes données
CH = CD.Path 'définit le chemin d'accès CH
F = Dir(CH & "\*.xlsx") 'définit le nom du premier fichier Excel du dossier CH
J = 1 'initialise la variable J
Do While F <> "" 'agit tant que la variable F n'est pas vide
    If F <> CD.Name Then 'condition 1 : si F n'est pas ce fichier
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante
        Set CS = Workbooks(F) 'définit le classeur source CS (génère une erreur si ce classeur n'est pas ouvert)
        If Err <> 0 Then 'condition 2 : si une erreur a été générée
            Err.Clear 'supprime l'erreur
            Workbooks.Open (CH & "\" & F) 'ouvre le fichier F
            Set CS = ActiveWorkbook 'définit le classeur source CS
        End If 'fin de la condition 2
        On Error GoTo 0 'annule la gestion des erreurs
        Set OS = CS.Sheets("Questionnaire") 'définit l'onglet source OS
        TC = OS.Range("B5:B34") 'définit le tableau de cellules TC (la plage des réponses)
        ReDim Preserve TL(1 To 21, 1 To J) 'redimensionne le tableau de lignes TL (21 lignes, J colonnes)
        TL(1, J) = TC(1, 1) 'récupère la réponse 1 dans ligne 1 de TL
        TL(2, J) = TC(2, 1) 'récupère la réponse 2 dans ligne 2 de TL
        TL(3, J) = TC(3, 1) 'récupère la réponse 3 dans ligne 3 de TL
        TL(4, J) = TC(5, 1) 'récupère la réponse 4 dans ligne 4 de TL
        TL(5, J) = TC(6, 1) 'récupère la réponse 5 dans ligne 5 de TL
        TL(6, J) = TC(7, 1) 'récupère la réponse 6 dans ligne 6 de TL
        TL(7, J) = TC(8, 1) 'récupère la réponse 7 dans ligne 7 de TL
        TL(8, J) = TC(10, 1) 'récupère la réponse 8 dans ligne 8 de TL
        TL(9, J) = TC(13, 1) 'récupère la réponse 9 dans ligne 9 de TL
        TL(10, J) = TC(14, 1) 'récupère la réponse 10 dans ligne 10 de TL
        TL(11, J) = TC(15, 1) 'récupère la réponse 11 dans ligne 11 de TL
        TL(12, J) = TC(16, 1) 'récupère la réponse 12 dans ligne 12 de TL
        TL(13, J) = TC(19, 1) 'récupère la réponse 13 dans ligne 13 de TL
        TL(14, J) = TC(20, 1) 'récupère la réponse 14 dans ligne 14 de TL
        TL(15, J) = TC(21, 1) 'récupère la réponse 15 dans ligne 15 de TL
        TL(16, J) = TC(22, 1) 'récupère la réponse 16 dans ligne 16 de TL
        TL(17, J) = TC(23, 1) 'récupère la réponse 17 dans ligne 17 de TL
        TL(18, J) = TC(25, 1) 'récupère la réponse 18 dans ligne 18 de TL
        TL(19, J) = TC(28, 1) 'récupère la réponse 19 dans ligne 19 de TL
        TL(20, J) = TC(29, 1) 'récupère la réponse 20 dans ligne 20 de TL
        TL(21, J) = TC(30, 1) 'récupère la réponse 21 dans ligne 21 de TL
        J = J + 1 'incrémente J (ajoute une colonne à TL
        CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
        F = Dir 'passe au prochain fichier du dossier
    End If 'fin de la condition 1
Loop 'boucle
If J = 1 Then Exit Sub 'si J=1, sort de la procédure
'renvoie dans la celllue A3 redimensionnée de l'onglet OD, le tableau TL tranposé
OD.Range("A3").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
Application.ScreenUpdating = True 'afficheles rafraîchissements d'écran
End Sub
36natou-v01.xlsm (28.72 Ko)

Bonjour,

Merci à vous, la 1ère solution me semble marcher (je finis mes tests) et correspond bien à notre besoin.

Merci beaucoup !!

Natacha

SI la solution convient

merci

Fred

Rechercher des sujets similaires à "fusion fichiers"