Recherche une macro qui va copier certaines données

Bonjour, je cherche une macro qui va copier certaines données (voir fichier). Merci de votre aide

Bonjour à tous!

ManuD, voici ton fichier en retour vois si cela te convient

Bonne journée!

Très bon travail mais si je mets quelque chose le 03 janvier et que j'enregistre, puis je rajoute le 07 janvier et bien le 03 janvier se remet encore dans ma feuille 3 (je ne désire pas de doublon) et encore un autre soucis c'est que je ne désire pas une mise forme juste les valeurs. Merci encore de votre aide.

Voici le code

Sub test()
Dim c As Variant
Dim F1, F2 As Worksheet
Set F1 = Worksheets("Feuil1")
Set F2 = Worksheets("Feuil3")
Application.ScreenUpdating = False
For Each c In F1.Range("D7:AH7")
If c <> "" Then
F2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = c.Offset(-1, 0)
c.Copy Destination:=F2.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next c
Application.ScreenUpdating = True
End Sub

Bonjour à tous !

ManuD, une autre approche comme ceci peut-être....

Merci mais j'ai trouvé avec ceci:

Sub test()
Dim c As Variant
Dim F1 As Worksheet
Dim F2 As Worksheet

Set F1 = Worksheets("Feuil1")
Set F2 = Worksheets("Feuil3")
Application.ScreenUpdating = False
With F2
.Range("A2").CurrentRegion.Offset(1, 0).ClearContents 'efface le résultat précédent
For Each c In F1.Range("D7:AH7")
If c <> "" Then
.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = c.Offset(-1, 0)
c.Copy Destination:=.Range("B" & .Rows.Count).End(xlUp).Offset(1, 0)
End If
Next c
End With
Application.ScreenUpdating = True
End Sub

Bonjour à tous!

ManuD, je suis bien content de savoir que mon aide a été inutile...

Bonne journée!