Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

comment fusionner plusieurs fichier excel en une seule feuilles excel

4,099 views
Skip to first unread message

patrick85

unread,
Sep 28, 2012, 6:07:30 PM9/28/12
to
Bonjour,

j'ai n fichier excel ayant une structure identique (nombre de colonne, entête de
colonne) mais le nom des fichiers est différent et le nombres de lignes change.
je souhaites centraliser tous ces fichiers sur une unique feuille.
Que dois-je faire j'ai office 2007 ?

Thierry

unread,
Sep 29, 2012, 3:16:52 AM9/29/12
to
Bonjour,
si vous avez Access 2007, importez tous vos fichiers Excel dans une même
table Access, puis exportez cette dernière
dans un ficher Excel...
Thierry



(\ _ /)
(='.'=)
(")-(") .

Merci de prendre note de ma nouvelle adresse : tgai...@outlook.com


"patrick85" a écrit dans le message de groupe de discussion :
KZydndpnH_s...@giganews.com...

MichD

unread,
Sep 30, 2012, 10:11:56 AM9/30/12
to
Bonjour,

Voici un exemple de code : il est de Ron de Bruin

Dans le code, tu dois adapter la valeur de certaines variables pour
qu'elles reflètent ton environnement de travail.

Si tu éprouves de la difficulté à comprendre certaines sections du code,
reviens poser une question sur le sujet

'----------------------------------------------------
Sub MergeAllWorkbooks()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, FNum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long

' Change this to the path\folder location of your files.
MyPath = "C:\Users\Ron\test"

' Add a slash at the end of the path if needed.
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

' If there are no Excel files in the folder, exit.
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

' Fill the myFiles array with the list of Excel files
' in the search folder.
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop

' Set various application properties.
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

' Add a new workbook with one sheet.
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1

' Loop through all files in the myFiles array.
If FNum > 0 Then
For FNum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
On Error GoTo 0

If Not mybook Is Nothing Then
On Error Resume Next

' Change this range to fit your own needs.
With mybook.Worksheets(1)
Set sourceRange = .Range("A1:C1")
End With

If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
' If source range uses all columns then
' skip this file.
If sourceRange.Columns.Count >= BaseWks.Columns.Count
Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0

If Not sourceRange Is Nothing Then

SourceRcount = sourceRange.Rows.Count

If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "There are not enough rows in the target
worksheet."
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else

' Copy the file name in column A.
With sourceRange
BaseWks.Cells(rnum, "A"). _
Resize(.Rows.Count).Value =
MyFiles(FNum)
End With

' Set the destination range.
Set destrange = BaseWks.Range("B" & rnum)

' Copy the values from the source range
' to the destination range.
With sourceRange
Set destrange = destrange. _
Resize(.Rows.Count,
.Columns.Count)
End With
destrange.Value = sourceRange.Value

rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If

Next FNum
BaseWks.Columns.AutoFit
End If

ExitTheSub:
' Restore the application properties.
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
'----------------------------------------------------

MichD
---------------------------------------------------------------

patrick85

unread,
Sep 30, 2012, 10:50:40 AM9/30/12
to
Le samedi 29 Septembre 2012 à 00:07 par patrick85 :
> Bonjour,
>
> j'ai n fichier excel ayant une structure identique (nombre de colonne,
> entête de colonne) mais le nom des fichiers est différent et le
> nombres de lignes change. je souhaites centraliser tous ces fichiers sur une
> unique feuille.
> Que dois-je faire j'ai office 2007 ?
bonjour,
Merci de ta réponse, cela reviens à copier tous les fichiers dans une feuillle
excel. sachant que nous ne pouvons importer qu'un fichier aprés l'autre,
l'opération reste assez longue, n'y a t il pas un moyen (macro ou autre) de
faire l'importation en une seule opération.

MichD

unread,
Sep 30, 2012, 11:17:10 AM9/30/12
to

La procédure boucler sur la première feuille de tous les
fichiers d'UN répertoire donné.

Toutes les feuilles de données sont réputées avoir
une ligne d'étiquette définissant les champs de la table.

Tu dois charger les 2 références suivantes à partir du menu de la
fenêtre de l'éditeur de code / barre des menus / outils / références
'---------------------------------------------
"Microsoft Dao 3.6 Objects librairy"
ET
"Microsoft Activex Data Object 2.8 librairy"
'---------------------------------------------

La procédure "Test" l'appel à la procédure :
"Extraire_Data_First_Excel_Sheet"
a 2 paramètres (A et B) définis en début de procédure. Par la suite, j'ai
écrit
plusieurs syntaxes possibles pour appeler la procédure, tu n'en retiens UNE.

La procédure suivante devrait être beaucoup plus rapide, car elle fait la
récupération
des données sans ouvrir les fichiers.

'------------------------------------------
Sub Test()
'Appel d'une procédure ayant 2 paramètres
'A ) Répertoire à scanner
'Ne pas oublier le "\" à la fin comme dans "c:\AAA\"

'B ) 'L'adresse de la première cellule du coin supérieur
'gauche où seront copiées les données recueillies
'Différentes syntaxes possibles d'indiquer la cellule
'à partir de laquelle seront copiés les résultats.

'----------1----------
'Même classeur que la procédure, dans la Feuil2
'Extraire_Data_First_Excel_Sheet "c:\AAA\", _
ThisWorkbook.Worksheets("Feuil2").Range("G10")

'-----------2----------
'Autre classeur ouvert que celui de la procédure
Extraire_Data_First_Excel_Sheet "c:\AAA\", _
Workbooks("Classeur2").Worksheets("Feuil2").Range("G10")

''-----------3----------
'Dans la feuille active du classeur actif au
'moment de lancer la procédure
' Extraire_Data_First_Excel_Sheet "c:\AAA\", Range("G10")

End Sub
'------------------------------------------

Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)

'Nécessite l 'ajoute de la bibliothèque suivante :
'"Microsoft Activex Data Object 2.x librairy"
' ET
'"Microsoft Dao 3.6 Objects librairy"

'Extrait les données de plusieurs classeurs d'un même
'répertoire en prenant pour acquis que les données ont
'la même structure. Le nom de la première feuille est
'obtenue par la fonction "FirstExcelSheetName"

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String
Dim file As String, C As Integer, Ok As Integer
Dim ModeCalcul As String

'Extrait le premier fichier du répertoire
file = Dir(Chemin & "\*.xls")

ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Do While file <> ""
'Exclure le classeur où sont copiées les données
'pour ne pas dédoubler les data...

If Chemin & Rg.Parent.Parent.Name <> Chemin & file Then
'Identifier la cellule supérieur de gauche
'où seront copiées les données
If Rg(1, 1) = "" Then
Set Rg = Rg(1, 1)
Else
Set Rg = Rg.EntireColumn.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious).Offset(1)
Ok = 1
End If

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & file & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'détermine le nom de la première feuille du classeur
NomFeuille = FirstExcelSheetName(Chemin & file)

'Détermine la requête à être exécuté
Requete = "SELECT * From [" & NomFeuille & "]"

'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic

'Copie le nom des champs du recordset vers Excel
'dans le cas du premier classeur seulement
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Rg.Offset(1).CopyFromRecordset Rst
Else
'Copie le recordset vers Excel
Rg.CopyFromRecordset Rst
End If
'Ferme le recordset et la connection
Rst.Close: Conn.Close
'Passe au classeur suivant
file = Dir()
Else
'Passe au classeur suivant si le fichier
'où sont copiées les données est le même
'que celui qui est traité dans cette sub.
file = Dir()
End If
Loop
Application.EnableEvents = True
Application.Calculation = ModeCalcul
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'------------------------------------------
Function FirstExcelSheetName(Fichier As String)
'"Microsoft Dao 3.6 Objects librairy"
Dim XlDb As DAO.Database
Dim TbL As DAO.TableDef
Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")
FirstExcelSheetName = XlDb.TableDefs(0).Name
XlDb.Close: Set XlDb = Nothing
End Function
'------------------------------------------

MichD
---------------------------------------------------------------

Jacquouille

unread,
Sep 30, 2012, 11:17:45 AM9/30/12
to
Bonsoir:

Quitte � dire l'�nerie du WE, as-tu essay� de nommer la plage en question
de la feuille 1, puis 2 ....d'un nom ressemblant � nom1, nom2 .....
Ensuite, tu demandes poliment � Excel de copier nom2 sous nom1, ....en
ins�rant � chaque fois un beau :
derL = [A65536].End(3).Row
Je suis certain que ce que Denis t'a propos� est meilleur, mais c'est du
grand breton et je n'y pige rien...
Bonne fin de WE

Jacquouille

" Le vin est au repas ce que le parfum est � la femme."
"patrick85" a �crit dans le message de groupe de discussion :
XtWdnSptT9j...@giganews.com...

Le samedi 29 Septembre 2012 � 00:07 par patrick85 :
> Bonjour,
>
> j'ai n fichier excel ayant une structure identique (nombre de colonne,
> ent�te de colonne) mais le nom des fichiers est diff�rent et le
> nombres de lignes change. je souhaites centraliser tous ces fichiers sur
> une
> unique feuille.
> Que dois-je faire j'ai office 2007 ?
bonjour,
Merci de ta r�ponse, cela reviens � copier tous les fichiers dans une
feuillle
excel. sachant que nous ne pouvons importer qu'un fichier apr�s l'autre,
l'op�ration reste assez longue, n'y a t il pas un moyen (macro ou autre) de
faire l'importation en une seule op�ration.

MichD

unread,
Sep 30, 2012, 11:22:51 AM9/30/12
to
J'oubliais, si le nom de la feuille d'où tu extrais les données est le même
pour tous les fichiers, tu peux augmenter la performance de la procédure
en renseignant cette variable du nom de la feuille au milieu de la procédure
Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)

'détermine le nom de la première feuille du classeur
NomFeuille = "NomDeLaFeuille"

En conséquence, tu n'auras pas besoin de cocher cette référence :
"Microsoft Dao 3.6 Objects librairy"
et la fonction : Function FirstExcelSheetName(Fichier As String)
devient inutile.


MichD
---------------------------------------------------------------


Jacquouille

unread,
Sep 30, 2012, 12:10:45 PM9/30/12
to
Re
Tes plages sont nommées nom1 de la feuille1, nom2 de la feuille2
La feuille de destination s'appelle "SOM"
Il n'y a aucun contrôle ni protection, mais chez moi, cela fonctionne
------------------------------
Sub Copier_les_plages()

For i = 1 To Sheets.Count - 1 ' -1 pour la feuille "som"
Sheets("Feuil" & i).Select
Range("nom" & i).Copy
Sheets("Som").Select
derl = [A65536].End(3).Row + 1
Range("A" & derl).Select
ActiveSheet.Paste
Next i
End Sub
------------------------
Bonne chance, mais je reste persuadé de la solution de Denis.

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"Jacquouille" a écrit dans le message de groupe de discussion :
50686299$0$3109$ba62...@news.skynet.be...

Bonsoir:

Quitte à dire l'ânerie du WE, as-tu essayé de nommer la plage en question
de la feuille 1, puis 2 ....d'un nom ressemblant à nom1, nom2 .....
Ensuite, tu demandes poliment à Excel de copier nom2 sous nom1, ....en
insérant à chaque fois un beau :
derL = [A65536].End(3).Row
Je suis certain que ce que Denis t'a proposé est meilleur, mais c'est du
grand breton et je n'y pige rien...
Bonne fin de WE

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"patrick85" a écrit dans le message de groupe de discussion :
XtWdnSptT9j...@giganews.com...

Le samedi 29 Septembre 2012 à 00:07 par patrick85 :
> Bonjour,
>
> j'ai n fichier excel ayant une structure identique (nombre de colonne,
> entête de colonne) mais le nom des fichiers est différent et le
> nombres de lignes change. je souhaites centraliser tous ces fichiers sur
> une
> unique feuille.
> Que dois-je faire j'ai office 2007 ?
bonjour,
Merci de ta réponse, cela reviens à copier tous les fichiers dans une
feuillle
excel. sachant que nous ne pouvons importer qu'un fichier aprés l'autre,
l'opération reste assez longue, n'y a t il pas un moyen (macro ou autre) de
faire l'importation en une seule opération.

patrick85

unread,
Sep 30, 2012, 12:13:28 PM9/30/12
to
Le samedi 29 Septembre 2012 à 00:07 par patrick85 :
> Bonjour,
>
> j'ai n fichier excel ayant une structure identique (nombre de colonne,
> entête de colonne) mais le nom des fichiers est différent et le
> nombres de lignes change. je souhaites centraliser tous ces fichiers sur une
> unique feuille.
> Que dois-je faire j'ai office 2007 ?
merci je suis vraiment nul en macro. quelle ligne dois je modifier

MichD

unread,
Sep 30, 2012, 4:07:15 PM9/30/12
to
| merci je suis vraiment nul en macro. quelle ligne dois je modifier

La meilleure façon d'apprendre, c'est de plonger...

Le hic, c'est que tu voudrais avoir une macro sophistiquée qui est forcément
un peu plus compliquée tout en étant novice en la matière. C'est 2 choses
qui
ne vont pas très bien ensemble!

DANS UN CLASSEUR TOUT NEUF :

1- La macro fait presque tout pour toi. Tu ouvres la fenêtre de l'éditeur
de code (VBA) raccourci clavier : Alt + F11

à partir de la barre des menus / outils / références / Tu coches le nom des
2 bibliothèques que j'ai donné
'---------------------------
"Microsoft Dao 3.6 Objects librairy"
ET
"Microsoft Activex Data Object 2.8 librairy"

'---------------------------
2- À partir du menu insertion, tu insères un Module

3 - Tu copies toutes les macros dans ce module

4 ) Dans la procédure "Test", tu insères ceci :
A ) Tu remplaces "c:\AAA\" par le chemin où sont tous tes fichiers
Excel que tu veux combiner
B ) Tu remplaces ceci :
Workbooks("Classeur2").Worksheets("Feuil2").Range("G10")
Par ceci : ThisWorkbook.Worksheets("Feuil1").Range("A1")

Tu adaptes le nom "Feuil1" par le nom de la feuille que tu as dans
ton classeur.

'------------------------------------------
Sub Test()

Extraire_Data_First_Excel_Sheet "c:\AAA\", _
Workbooks("Classeur2").Worksheets("Feuil2").Range("G10")

End Sub
'------------------------------------------

Et pour lancer la macro Test() , tu reviens dans l'interface de la feuille
de calcul
Raccourci clavier F8 tu sélectionnes dans la fenêtre la macro "Test" et tu
cliques
sur le bouton "Exécuter"

Important : La macro suppose que la feuille de chaque classeur que tu veux
importer
et la première feuille à partir de la gauche.

Si le nom de la feuille est la même pour chaque classeur,
au milieu de la procédure Sub Extraire_Data_First_Excel_Sheet(Chemin As
String, Rg As Range)
Tu remplaces ceci :

'détermine le nom de la première feuille du classeur
NomFeuille = FirstExcelSheetName(Chemin & file)

Par :
'détermine le nom de la première feuille du classeur
NomFeuille = "LeNomDeLaDiteFeuille" ' entre guillemets"


C'est le mieux que je peux faire!


MichD
---------------------------------------------------------------

Jacquouille

unread,
Sep 30, 2012, 4:16:47 PM9/30/12
to
"MichD" a écrit dans le message de groupe de discussion :
k4a8pe$25c$1...@speranza.aioe.org...
>> C'est le mieux que je peux faire!

MichD
---------------------------------------------------------------

Pfffft

Tu peux mieux, en trois lignes:

1- TU prends la main à distance avec TeamViewerQS
2- Tu fais la manip
3- Tu rends la main.

-))
NON, pas taper !

MichD

unread,
Sep 30, 2012, 4:43:52 PM9/30/12
to
Bien sûr, on peut faire mieux, comme ceci, une ligne!

Sub Test(): Extraie_Data_First_Excel_Sheet "c:\AAA\",
Workbooks("Classeur2").Worksheets("Feuil2").Range("G10"): End Sub

MichD
---------------------------------------------------------------

Jacquouille

unread,
Oct 1, 2012, 7:53:24 AM10/1/12
to
Bien joué. -))



Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"MichD" a écrit dans le message de groupe de discussion :
k4aau5$85o$1...@speranza.aioe.org...
0 new messages