> Tous les forums > Forum Bureautique
 fusion de plusieurs documents excel
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
francous1959
  Posté le 24/08/2005 @ 15:58 
Aller en bas de la page 
Petite astucienne
j'ai saisie 300 fichiers excel je voudrai fusionner ces fichiers dans un seul fichier excel un fichier excel correspondant à une ligne du nveau fichier je ne veux pas resaisir les données, est il possible de récupérer les données par une macro. j'espère avoir été claire et merci pour votre aide
Publicité
user01
 Posté le 24/08/2005 à 17:51 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien
copier / coller
pat1545
 Posté le 24/08/2005 à 21:53 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien
Salut, essaies ceci, ça doit fonctionner mais à lire avant car tous les fichiers ET celui d'acceuil doivent etre dans le meme répertoire et avoir une "feuil1" Attention aux lignes trop longues coupées évantuellement par ce site Patrick Sub CopierDesData() 'inspiré largement d'un code de Denis sur MPFE 'Avril 2005 'Section déclaration des variables Dim Wk As Workbook, Rg As Range Dim Repertoire As String Dim Fichier As String, Ligne As Long Dim Last As Integer Dim Newf, Plage 'Répertoire où sont tes fichiers Excel Repertoire = "d:\files excel\testfusion\" ' à adapter ' le fichier où je regroupe est dans le meme répertoire que les autres fichiers !!! 'Fichier contient le premier fichier qui sera traité. Fichier = Dir(Repertoire & "*.xls") 'Déterminer où les données seront copiées 'Dans la feuille "Feuil1" du classeur où 'tu copieras cette procédure, En colonne A:A With ThisWorkbook.Worksheets("Feuil1") ' attention "FEUIL1" pour la feuille d'acceuil If .Range("A1") = "" Then Set Rg = .Range("A1") Else Last = Range("A65000").End(xlUp).Row Set Rg = Range("A" & Last) End If End With Application.ScreenUpdating = False 'Ceci est une boucle qui traitera à tour de rôle TOUS les 'fichiers Excel du répertoire. Elle copiera la plage de la ' feuil1 de chaque classeur ouvert vers la feuil1 de 'ce classeur, les données à la suite des autres ... Do While Fichier <> "regr" 'Test pour s'assurer que le fichier est 'différent de celui-ci (récipient du résultat) If Fichier = ThisWorkbook.Name Then Exit Sub If Fichier <> ThisWorkbook.Name Then 'Attribue à la variable Wk, le classeur qui 's'ouvre Set Wk = Workbooks.Open(Repertoire & Fichier) 'Copie vers Rg, la plage A15:A25 de la feuil1 With Wk.Worksheets("Feuil1") Set Newf = ActiveWorkbook Range("A1").Activate Selection.CurrentRegion.Select Set Plage = Selection Plage.Copy Destination:=Rg End With 'Détermine la nouvelle Plage où seront copiées 'les données du prochain classeur à ouvrir Set Rg = Rg(65536 - Rg.Row).End(xlUp).Offset(1) 'Ferme le classeur que tu viens d'ouvrir sans 'rien sauvegarder Wk.Close False 'attribue à la variable fichier, le nom du prochain 'fichier à ouvrir Fichier = Dir End If Loop 'Libère l'espace mémoire occupé par ces variables. Set Wk = Nothing: Set Rg = Nothing End Sub
Page : [1] 
Page 1 sur 1

Vous devez être connecté pour poster des messages. Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !


Sujets relatifs
Fusion de 2 ou plusieurs documents Office en 1 ?
Fusion plusieurs classeurs excel en VBA
excel: effacer le contenu ds plusieurs feuilles
copier sur plusieurs feuilles excel en meme temps
Excel: différent de plusieurs éléments
Word fermer plusieurs documents en un clic
documents excel et word ne s'ouvrent plus
[Excel 2013] Fusion personnalisée de cellules
Excel 97 Regrouper plusieurs onglets en un MEGA onglet
Passer plusieurs variables dans une autre macro excel VBA
Plus de sujets relatifs à fusion de plusieurs documents excel
 > Tous les forums > Forum Bureautique