Bonjour René et à tous,
Pour faire ce que tu demandes, essaie ce code :
Sub Transfert()
Windows('NOM DU CLASSEUR 1.xls').Activate
Sheets('XL001').Select
range('A840:f849').select
Selection.Copy
Windows('NOM DU CLASSEUR QUI RECOIT.xls').Activate
Sheets('XL999').Select
Range('A1').Select
ActiveSheet.Paste
Windows('NOM DU CLASSEUR 2.xls').Activate
Sheets('XL002').Select
range('A840:F849').select
Selection.Copy
Windows('NOM DU CLASSEUR QUI RECOIT.xls').Activate
Sheets('XL999').Select
Range('A10').Select
ActiveSheet.Paste
End Sub
Celà ne marchera qu'une fois car on recopie toujours en A1 et en A10.
Si il faut rajouter les copies les unes en dessous des autres, il faudra utiliser ce code-ci:
Sub Transfert()
Windows('NOM DU CLASSEUR 1.xls').Activate
Sheets('XL001').Select
range('A840:f849').select
Selection.Copy
Windows('NOM DU CLASSEUR QUI RECOIT.xls').Activate
Sheets('XL999').Select
Range('A1').Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Windows('NOM DU CLASSEUR 2.xls').Activate
Sheets('XL002').Select
range('A840:F849').select
Selection.Copy
Windows('NOM DU CLASSEUR QUI RECOIT.xls').Activate
Sheets('XL999').Select
Range('A10').Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
End Sub
Attention, dans ce cas il faut avoir dans XL999 les cellules A1 et A2 déjà remplies, sinon pour la première copie ça file une erreur.
J'espère que celà te conviendras.
Tiens-nous au courant.
A+