Automatiser tache de copier coller plusieurs documents vers un seul document destinat

[newby_macroxls]

Bonjour a tous,

je suis assez novice en ce qui concerne les macros excel, et ai besoin d´aide sur l´automatisation d´une tache...

En effet, je recois une fois par mois, jusqu´a 40 fichiers ayant tous le meme format, mais des noms differents. il s´agit de formulaires de saisie avec 3 onglets. les cellules sont parfois concetenées pour une meilleure mise en forme.

Pour pouvoir en traiter les données, j´ai un fichier destinataire (toto), un tableau avec les colonnes qui correspondent aux données qui m´interessent dans les fichiers sources.

ainsi, aujourd´hui je fais un copier coller pour chaque fichier vers le document destinataire toto. Chaque fichier source correspond a une ligne dans mon document toto. Exemple, dans le document source dede1, sheet1, je copie la cellule D6-E6, et je la colle en document toto, sheet1, en cellule A4 (sans mise en forme, et effacer la concatenation).
ensuite je copie dede1, sheet2, B5-M5 vers toto, sheet1 A5 (colonne suivante).... etc pour chaque cellule du formulaire.

Savez-vous comment faire pour automatiser cette tache?

Merci bcp bcp pour votre aide!

Savez vous comment automatiser cette tache??

Christine

 

[VDAVID]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

Bonjour Christine,
Une première approche; si tous les fichiers que tu veux prendre en compte sont dans le même fichier :

Sub ouvrir_fichiers()
'l'instruction ChDir permet de se positionner
'sur un répertoire précis

ChDir "C:\Documents and Settings\VDAVID\Bureau\Test macro\Lol" ' Le chemin de ton fichier
Monfichier = Dir("*.*")
While Monfichier <> ""
Workbooks.Open Monfichier
Monfichier = Dir()

x = Workbooks("Classeur1").Sheets("Feuil1").Range("B1").Value + 1
z = x + 1
ActiveWorkbook.Sheets(1).Range("D6:E6").Copy
Workbooks("Classeur1").Sheets("Feuil1").Range("A" & x).PasteSpecial (xlValues)
ActiveWorkbook.Sheets(1).Range("B5:M5").Copy
Workbooks("Classeur1").Sheets("Feuil1").Range("A" & z).PasteSpecial (xlValues)

Wend

End SubEnd Sub

EDIT :
Tu met la formule =EQUIV(9^9;A:A;1) dans la case B1; et à condition que A3 ne soit pas vide, il te mettra automatiquement à la suite les valeurs cherchées dans les classeurs.


Il faut l'adapter en fonction de ce que tu veux copier ...
Ici, c'est en supposant que pour toutes les feuilles tu copies de D6 à E6 et de B5 à M5
Bonne journée !

 

[newby_macroxls]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

Bonjour Xdavid

Merci pour ton aide
Cependant j´ai un message d´erreur Run time error 1004 - PasteSpecial method of Range class failed...

Sais-tu comment corriger cela?

 

[VDAVID]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

Re Newby,
Quand j'ai copié le code sur le forum, les deux "(xlValues)" se sont décalés d'une ligne, provoquant l'erreur de synthaxe il faut les remettres à la ligne comme ceci :

Workbooks("Classeur1").Sheets("Feuil1").Range("A4").PasteSpecial (xlValues)

PS : C'est VDAVID, je ne fais pas de films pour adultes

Ce n'est qu'une première approche, il y'a la méthode de sélection pour la copie à revoir je suis en train de regarder

 

[jpb388]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

Bonjour newby_macroxls,VDAVID et le forum
Autre solution
copier et coller dans ThisWorkbook
précaution : toto doit être ouvert
il suffit de double cliquez sur n'importe quelle feuille du classeur à copier

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Plage As Range
On Error Resume Next
Set Plage = Application.InputBox("Selectionner la plage :", "Transfert", , , , , , 8)
If Plage Is Nothing Then Exit Sub
Dim Lg%
Lg = Workbooks("Toto.xls").Sheets(1).Range("a65000").End(xlUp).Row
If Lg < 4 Then Lg = 4
Plage.Copy
Workbooks("Toto.xls").Sheets(1).Range("a" & Lg).PasteSpecial Paste:=xlPasteValues
End Sub

 

[VDAVID]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

EDIT :
J'ai modifié mon premier post normalement ça doit bien fonctionner, je l'ai tester; ca reste limité aux D6 à E6 et B5 à M5 que tu voulais copier. Prends bien note de mon commentaire en dessous par contre
Bonne journée

 

[newby_macroxls]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

Bonjour a tous a nouveau,

J´ai essayé de suivre vos conseils, mais sans succès
Alors voila ce qu´un ami a reussi pour moi :

Sub ouvrir_fichiers()
ChDir "C:\Documents\Testmacro"
Monfichier = Dir("*.*")
While Monfichier <> ""
Workbooks.Open Monfichier
Monfichier = Dir()
x = Workbooks("toto.xls").Sheets("Sheet1").Range("B1").Value + 1
z = x + 1
ActiveWorkbook.Sheets(1).Range("D6:E6").Copy
Workbooks("toto.xls").Sheets("Sheet1").Range("A" & x).PasteSpecial (xlValues)
ActiveWorkbook.Sheets(1).Range("B5:C5").Copy
Workbooks("toto.xls").Sheets("Sheet1").Range("A" & z).PasteSpecial (xlValues)
ActiveWindow.Close
Wend
End Sub

J'arrive à copier les cases demandé dans le premier excel du dossier
mais lorsqu'il ouvre le second fichier pour copier les cases, il me sort un message 'Incompatibilité de type'

Savez-vous pourquoi et comment corriger cela?

Merciiiiiiii!!!

 

[newby_macroxls]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

Ne serait ce pas dû au fait que lors de l'écriture des données du second fichier, il tente d'écraser les premières?
ou du fait que des cases soient selectionner dans le fichier toto.xls qui empeche l'ecriture des données du second fichier dans les cases suivantes?

 

[jpb388]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

re
peux tu mettre ton fichier en ligne que l'on puisse voir où cela cloche
a+

 

[Pierrot93]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

Bonjour,

petite remarque au passage, avec ceci :

Monfichier = Dir("*.*")

tu vas chercher à ouvrir tous les types de fichiers...
peut être limiter aux "xls"...

Monfichier = Dir("*.xls")

bon après midi
@+

 

[newby_macroxls]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

Voila les fichiers exemples...

 

[jpb388]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

re
Merci pour les classeurs mais il faut incorporer tes macro sinon on ne peut pas contrôler
a+

 

[newby_macroxls]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

Oui, alors voici le fichier qui doit rappatrier les donnees et qui contient donc le code vba...

Merci pour l´aide!!
Christine

 

[jpb388]

Re : Automatiser tache de copier coller plusieurs documents vers un seul document des

re

x = Workbooks("toto.xls").Sheets("Sheet1").Range("B1").Value + 1

lors du 1er passage x=toto b1 est vide donc 1
au 2eme b1=1B1 soit du texte il ne peut pas additionner du texte avec 1
ci joint la macro qui chez moi fonctionne

Sub ouvrir_fichiers()
Monfichier = Dir("*.xls")
While Monfichier <> ""
If Monfichier = "toto.xls" Then Exit Sub
Workbooks.Open Monfichier
Monfichier = Dir()
x = Workbooks("toto.xls").Sheets("Sheet1").Range("B65000").End(xlUp).Row + 1
z = x + 1
ActiveWorkbook.Sheets(1).Range("A1:B1").Copy
Workbooks("toto.xls").Sheets("Sheet1").Range("A" & x).PasteSpecial (xlValues)
ActiveWorkbook.Sheets(1).Range("A2:B2").Copy
Workbooks("toto.xls").Sheets("Sheet1").Range("A" & z).PasteSpecial (xlValues)
ActiveWindow.Close
Wend
End Sub

a+