Copies entre plusieurs classeurs

[franck]

Bonjour le forum,
J'attend désespérément une solution à mon probleme depuis plusieurs jours et n'ayant reçu aucune réponse, je me permet de vous relancer sur c enouveau fil.

Je joins 3 classseur qui constituent un squelette de mon dossier.
Le 1er classeur(nommé "source") contient des chiffres d'affaires à la semaine par type de produits et s'actualise automatiquement en cliquant sur la cellule A1(ce n'ai pas une macro) qui va chercher les infos dans la base de données interne de l'entreprise. Je voudrais créer une macro dans ce 1er classeur qui selon la nature des produits et à chaque semaine me copie automatiquement les données vers les 2 autres classeurs et qu'elles s'enregistrent au fur et à mesure.
Dans le classeur " source", j'ai donc une seule colonne de chiffre qui s'actualise en changeant le n° de semaine. Par contre, pour les 2 autres classeurs, toutes les semaines doivent apparaîtrent.
Merci pour votre aide. Je ne sais vraiment pas creer une macro qui déplace le copier/coller vers la droite.

Merci pour votre aide

Bonne journée à toutes et à tous

 

[michel]

bonjour Franck

peux tu tester ma procedure ci dessous . les 3 classeurs doivent etre dans le meme repertoire . tableau1 eet tableau2 doivent etre fermés lors du lancement de la macro

Sub ConsolidationProduits()
Dim Val As String
Dim Cell As Object

Val = ThisWorkbook.Sheets(1).Range("C4")
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Tableau1
Workbooks.Open FileName:=ThisWorkbook.Path & "\tableau 1.xls"
With ActiveWorkbook.Sheets(1).Range("C4:BB4")
Set Cell = .Find(Val, LookIn:=xlValues)
If Not Cell Is Nothing Then

ThisWorkbook.Sheets(1).Range("C8:C17").Copy
Cell.Offset(1, 0).PasteSpecial

Else
MsgBox " Numero de semaine non trouvé . "
ActiveWorkbook.Close
Application.DisplayAlerts = True
Exit Sub
End If
End With
ActiveWorkbook.Close savechanges:=True

'Tableau2
Workbooks.Open FileName:=ThisWorkbook.Path & "\tableau 2.xls"
With ActiveWorkbook.Sheets(1).Range("C4:BB4")
Set Cell = .Find(Val, LookIn:=xlValues)
If Not Cell Is Nothing Then

ThisWorkbook.Sheets(1).Range("C19:C28").Copy
Cell.Offset(1, 0).PasteSpecial

Else
MsgBox " Numero de semaine non trouvée . "
ActiveWorkbook.Close
Application.DisplayAlerts = True
Exit Sub
End If
End With
ActiveWorkbook.Close savechanges:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

bon apres midi
michel

 

[franck]

Merci, Merci, Mr Michel !
Ton programme marche. Mais j'ai dû enlever ta dernière ligne "Application.CutCopyMode=False" car l'ordinateur affichait un echec dû a cette ligne. Je l'ai enlevé et tous semble fonctionner normalement.
Tu crois que cette ligne peut être enlever ?
J'ai joins mon dossier pour ceux que ça intétresse.

Merci encore,

Bonne apres- midi Michel et à vous tous

 

[michel]

rebonjour Franck

c'est curieux . après plusiseurs essais je n'ai pas ce soucis chez moi (excel97)

Application.CutCopyMode = False permet de vider le contenu du presse papier après les actions de copier/coller
en principe , l'enlever ne bloque pas le fonctionnement de la procedure

bon apres midi
michel

 

[franck]

Rebonjour Michel,

Merci pour ta précision. J'ai aussi excel 97. Je vais laisser le programme donc sans cette ligne.

Bonne soirée,

Franck