Copier/ coller de colonne suivant date et numero de semaine

Bonjour à tous

Voici mon besoin:

J'ai un tableau de donnée classée suivant les mois de l'année et j'ai besoin de copier les données du mois à n'importe quel moment dans un tableau classé par semaine.

suivant le numero de semaine indiqué j'ai besoin de faire une recherche du mois qui correspond à cette semaine pour copier les données de la colonne correspondante et les coller dans la colonne de la semaine indiquée.

Il est possibleque cette manipulation se fasse plusieur fois pour la m^me semaine donc besoin d'effacer les ancienns données et de copier les nouvelles.

je ne suis pas un pro en VBA et j'aimerai votre aide

Merci beaucoup

Je vous fais suivre le tableau concerné. je suis sous excel 2016 mais je l'envoie aussi en 97

Bonjour à tous,

On m'a fait suivre ce code mais que j'ai adapté ensuite mais j'aimerai uniquement copier et coller les valeurs sans les formules

Merci

Private Sub Worksheet_Change(ByVal Target As Range)

Dim R1 As Range 'déclare la variable R1 (Recherche 1)

Dim R2 As Range 'déclare la variable R2 (Recherche 2)

Dim R3 As Range 'déclare la variable R3 (Recherche 3)

Dim D As Date 'déclare la variable D (Date)

If Target.Address <> "$A$196" Then Exit Sub 'si le changement a lieu ailleurs qu'en A196, sort de la procédure

If Target.Value = "" Then Exit Sub 'si A196 est effacée, sort de la procédure

Set R1 = Range("AI1").CurrentRegion.Find(Target.Value, , xlValues, xlWhole) 'définit la première recherche R1 (recherche le numéro de la semaine dans la colonne AI)

D = DateSerial(Year(R1.Offset(0, 1)), Month(R1.Offset(0, 1)), 1) 'définit la date D en fonction de l'occurrence trouvée

Set R2 = Range("P120:AA120").Find(D, , xlFormulas, xlWhole) 'redéfinit la recherche R2 (recherche la date dans la plage P120 :AA120)

Set R3 = Range("O198:AE198").Find(Target.Value, , xlValues, xlWhole) 'redéfinit la recherche R3 (recherche le numéro de la semaine dans la plage O198:AE198)

R2.Offset(1, 0).Resize(15, 1).Copy R3.Offset(1, 0) 'copie les valeur du mois dans la cellule R3 décalé d'une ligne vers le bas

End Sub

Bonjour Jehu, bonjour le forum,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R1 As Range 'déclare la variable R1 (Recherche 1)
Dim R2 As Range 'déclare la variable R2 (Recherche 2)
Dim R3 As Range 'déclare la variable R3 (Recherche 3)
Dim D As Date 'déclare la variable D (Date)

If Target.Address <> "$A$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en A1, sort de la procédure
If Target.Value = "" Then Exit Sub 'si A1 est effacée, sort de la procédure
Set R1 = Range("S1").CurrentRegion.Find(Target.Value, , xlValues, xlWhole) 'définit la première recherche R1 (recherche le numéro de la semaine dans la colonne S)
D = DateSerial(Year(R1.Offset(0, 1)), Month(R1.Offset(0, 1)), 1) 'définit la date D en fonction de l'occurrence trouvée
Set R2 = Range("B3:M3").Find(D, , xlFormulas, xlWhole) 'redéfinit la recherche R2 (recherche la date dans la plage B3:M3)
Set R3 = Range("B14:M14").Find(Target.Value, , xlValues, xlWhole) 'redéfinit la recherche R3 (recherche le numéro de la semaine dans la plage B14:M14)
R2.Offset(1, 0).Resize(15, 1).Copy 'copie les valeur du mois
R3.Offset(1, 0).PasteSpecial (xlPasteValues) 'colle la valeur dans la cellule R3 décalé d'une ligne vers le bas
End Sub

Désolé je navet (si, si, dans ce cas on peut) pas vu que tu avais relancé dans l'autre forum...

Bonjour Thau Thème.

Vraiment super. Ca marche nickel.

juste un dernier service. J'ai du rajouter 2 lignes en 5 et 8. ce sont des lignes masquées que je ne veut pas copier. donc je veux faire un copie des lignes 4,6,7,9,10,11,12.

Y a t'il une astuce

Merci encore

Re,

Tu t'arrêtes quand ?

En fonction de la demande, telle ou telle méthode est préférable... Oui il y a une astuce mais comme la méthode change je ne peux regarder maintenant car je dois partir...

Re

je te fais suivre le nouveau fichier. Par contre comme je cache des lignes j'ai était obligé de déplacer la base sur la feuil 2, ce qui je pense va aussi faire une modification.

Merci encore pour ton aide

Re,

Non testé. Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R1 As Range 'déclare la variable R1 (Recherche 1)
Dim R2 As Range 'déclare la variable R2 (Recherche 2)
Dim R3 As Range 'déclare la variable R3 (Recherche 3)
Dim D As Date 'déclare la variable D (Date)
Dim PL As Range 'déclare la variable PL (PLage)

If Target.Address <> "$A$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en A1, sort de la procédure
If Target.Value = "" Then Exit Sub 'si A1 est effacée, sort de la procédure
Set R1 = Range("S1").CurrentRegion.Find(Target.Value, , xlValues, xlWhole) 'définit la première recherche R1 (recherche le numéro de la semaine dans la colonne S)
D = DateSerial(Year(R1.Offset(0, 1)), Month(R1.Offset(0, 1)), 1) 'définit la date D en fonction de l'occurrence trouvée
Set R2 = Range("B3:M3").Find(D, , xlFormulas, xlWhole) 'redéfinit la recherche R2 (recherche la date dans la plage B3:M3)
Set R3 = Range("B14:M14").Find(Target.Value, , xlValues, xlWhole) 'redéfinit la recherche R3 (recherche le numéro de la semaine dans la plage B14:M14)
Set PL = Application.Union(R2.Offset(1, 0), r.Offset(3, 0).Resize(1, 2), r.Offset(6, 0).Resize(1, 4)) 'définit la plage PL
PL.Copy 'copie les valeur du mois
R3.Offset(1, 0).PasteSpecial (xlPasteValues) 'colle la valeur dans la cellule R3 décalé d'une ligne vers le bas
End Sub

Cela Bugg à la fonction

Set PL = Application.Union...

Bonjour le fil, le forum,

En effet, Jehu, le code était erroné, pardon ! Le voici adapté à ton dernier fichier :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim F1 As Worksheet 'déclare la variable F1 (onglet Feuil1")
Dim F2 As Worksheet 'déclare la variable F2 (onglet Feuil2")
Dim R1 As Range 'déclare la variable R1 (Recherche 1)
Dim R2 As Range 'déclare la variable R2 (Recherche 2)
Dim R3 As Range 'déclare la variable R3 (Recherche 3)
Dim D As Date 'déclare la variable D (Date)
Dim TV(1 To 7) As Variant 'déclare la variabel TV (Tableau des Valeurs)

Set F1 = Worksheets("Feuil1") 'définit l'onglet F1
Set F2 = Worksheets("Feuil2") 'définit l'onglet F2
If Target.Address <> "$A$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en A1, sort de la procédure
If Target.Value = "" Then Exit Sub 'si A1 est effacée, sort de la procédure
Set R1 = F2.Columns(1).Find(Target.Value, , xlValues, xlWhole) 'définit la première recherche R1 (recherche le numéro de la semaine dans la colonne S)
D = DateSerial(Year(R1.Offset(0, 1)), Month(R1.Offset(0, 1)), 1) 'définit la date D en fonction de l'occurrence trouvée
Set R2 = F1.Range("B3:M3").Find(D, , xlFormulas, xlWhole) 'redéfinit la recherche R2 (recherche la date dans la plage B3:M3)
Set R3 = F1.Range("B16:M16").Find(Target.Value, , xlValues, xlWhole) 'redéfinit la recherche R3 (recherche le numéro de la semaine dans la plage B14:M14)
TV(1) = R2.Offset(1, 0) 'définit la valeur 1 de TV
TV(2) = R2.Offset(3, 0) 'définit la valeur 2 de TV
TV(3) = R2.Offset(4, 0) 'définit la valeur 3 de TV
TV(4) = R2.Offset(5, 0) 'définit la valeur 4 de TV
TV(5) = R2.Offset(7, 0) 'définit la valeur 5 de TV
TV(6) = R2.Offset(8, 0) 'définit la valeur 6 de TV
TV(7) = R2.Offset(9, 0) 'définit la valeur 7 de TV
'renvoie  le tableau des valeur dans la cellule R3 décalé d'une ligne vers le bas et redimensionnée
R3.Offset(1, 0).Resize(7, 1).Value = Application.Transpose(TV)
End Sub

Le fichier :

Un grand merci ThauThème pour ton aide et ta patience. c'est parfait.