Fusionner des classeurs Excel, mais pas que ...

Fusionner des classeurs Excel, mais pas que ... - VB/VBA/VBS - Programmation

Marsh Posté le 08-12-2016 à 18:15:14    

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
Reply

Marsh Posté le 08-12-2016 à 18:15:14   

Reply

Marsh Posté le 08-12-2016 à 23:01:18    

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

Reply

Marsh Posté le 11-12-2016 à 22:28:42    

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 :
  1. Sub GetSheets()
  2. Path = "C:\Mes documents\Input\"
  3. Filename = Dir(Path & "*.xlsx" )
  4. OutputWb = ActiveWorkbook.Name
  5. FirstWb = True
  6. Application.DisplayAlerts = False
  8.   Do While Filename <> ""
  9.     Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
  10.    
  11.     With ThisWorkbook
  12.    
  13.         If FirstWb Then
  14.             ActiveSheet.Copy After:=.Sheets(1)
  15.             .ActiveSheet.Name = "Output"
  16.             FirstWb = False
  17.            
  18.             Data = .ActiveSheet.Range("B2" ).Value
  19.             .ActiveSheet.Range("B2" ).Clear
  20.             LastRow = .ActiveSheet.Cells(.ActiveSheet.Rows.Count, "A" ).End(xlUp).Row
  21.             .ActiveSheet.Range(.ActiveSheet.Cells(7, 8), .ActiveSheet.Cells(LastRow, 8)).Value = Data
  22.         Else
  23.             Data = ActiveSheet.Range("B2" ).Value
  24.             ActiveSheet.Range("A7:G30" ).Copy
  25.             FirstRow = .ActiveSheet.Cells(.ActiveSheet.Rows.Count, "A" ).End(xlUp).Row + 1
  26.             .ActiveSheet.Rows(FirstRow).PasteSpecial xlPasteValues
  27.             LastRow = .ActiveSheet.Cells(.ActiveSheet.Rows.Count, "A" ).End(xlUp).Row
  28.             Data = ActiveSheet.Range("B2" ).Value
  29.             .ActiveSheet.Range(.ActiveSheet.Cells(FirstRow, 8), .ActiveSheet.Cells(LastRow, 8)).Value = Data
  30.          
  31.        End If
  32.      
  33.        Workbooks(Filename).Close
  34.        Filename = Dir()
  35.         End With
  36.     Loop
  38.   Application.DisplayAlerts = True
  39.  
  40. End Sub

Reply

Marsh Posté le 13-12-2016 à 17:10:39    

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
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed