Fusionner des classeurs Excel, mais pas que ...

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Fusionner des classeurs Excel, mais pas que ...

alexstain

Geek en stock

Bonjour,

Je sais que ma question a déjà été partiellement traitée ailleurs, mais je ne suis pas développeur, je ne connais strictement rien au VBA.

J'ai 63 classeurs excel d'une seule feuille, d'une vingtaine de lignes.
Ma ligne de titre est la ligne 6
En dessous il peut y a voir de 2 à 20 lignes, à la louche.

J'ai besoin de fusionner tous ces classeurs en un seul, dans une seule feuille.
Les lignes 1,2,3,4,5 sont facultatives.
J'ai besoin que la ligne 6 soit reprise, ainsi que toutes les lignes remplies en dessous, ainsi que les colonnes A,B,C,D,E,F,G soient reprises.
J'ai besoin que pour chaque ligne reprise d'un classeur, la valeur dans ce classeur de la cellule B2 soit reprise en colonne H.
Par exemple pour le fichier ZOZO, dont la valeur B2 indique 07/12/2016, toutes les lignes reprises indiquent en colonne H "07/12/2016".

Tous les fichiers Excel sont dans un dossier de "Mes documents".

Une bonne âme aurait elle l'extrème gentillesse de me composer une macro ?

MERCI !!

---------------
Ventes : http://forum.hardware.fr/forum2.ph [...] #t16617873

Publicité

Wolfman

Lobo'tomizado

Ce sujet a été déplacé de la catégorie Windows & Software vers la categorie Programmation par Wolfman

x140hu4

Salut,

Créée un fichier excel, va dans le developeur (a activer dans le ribbon au dessus de excel)>Visual Basic>Ajouter un module et copie le code en dessous.

Il faut que tu créées un folder input ou tu devras mettre tes fichiers. Si tes fichiers ne sont pas en xlsx, change l'extension dans le Filename en dessous.

Je l'ai fait a la va vite donc c'est pas super propre mais ca devrait faire l'affaire

Code :

Sub GetSheets()
Path = "C:\Mes documents\Input\"
Filename = Dir(Path & "*.xlsx" )
OutputWb = ActiveWorkbook.Name
FirstWb = True
Application.DisplayAlerts = False
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
With ThisWorkbook
If FirstWb Then
ActiveSheet.Copy After:=.Sheets(1)
.ActiveSheet.Name = "Output"
FirstWb = False
Data = .ActiveSheet.Range("B2" ).Value
.ActiveSheet.Range("B2" ).Clear
LastRow = .ActiveSheet.Cells(.ActiveSheet.Rows.Count, "A" ).End(xlUp).Row
.ActiveSheet.Range(.ActiveSheet.Cells(7, 8), .ActiveSheet.Cells(LastRow, 8)).Value = Data
Else
Data = ActiveSheet.Range("B2" ).Value
ActiveSheet.Range("A7:G30" ).Copy
FirstRow = .ActiveSheet.Cells(.ActiveSheet.Rows.Count, "A" ).End(xlUp).Row + 1
.ActiveSheet.Rows(FirstRow).PasteSpecial xlPasteValues
LastRow = .ActiveSheet.Cells(.ActiveSheet.Rows.Count, "A" ).End(xlUp).Row
Data = ActiveSheet.Range("B2" ).Value
.ActiveSheet.Range(.ActiveSheet.Cells(FirstRow, 8), .ActiveSheet.Cells(LastRow, 8)).Value = Data
End If
Workbooks(Filename).Close
Filename = Dir()
End With
Loop
Application.DisplayAlerts = True
End Sub

alexstain

Geek en stock

Testé et approuvé !
Merci beaucoup !

Si un jour tu as le temps de détailler les étapes en français dans le texte genre 'récupération des fichiers excel', histoire que j'apprenne, ce serait juste génial.

Bonne soirée

---------------
Ventes : http://forum.hardware.fr/forum2.ph [...] #t16617873

FORUM HardWare.fr

Programmation

VB/VBA/VBS

Fusionner des classeurs Excel, mais pas que ...

Sujets relatifs
Transfert de données Excel WEB	VBA-excel Copier-Coller après InputBox
[PYTHON] VBA & Formules Excel vers site web Python	Choix de configurations a l'ouverture d'un fichier Excel
Novice en VBA (Projet Excel)	Transcription formule excel en VBA
verrouiller un fichier excel avec une macro	Automatisation fichier excel avec VBA
Excel 2013, option recherche champs TCD	[VBA] Cacher bouton excel utilisateurs AD
Plus de sujets relatifs à : Fusionner des classeurs Excel, mais pas que ...

Page générée en 0.051 secondes