Copier une valeur vers une feuille en fonction date

Bonjour

J'aimerai copier la valeur de ma cellule C2 de ma feuille "Stats a N" vers ma feuille "classement_boutiques_Juin" dans la première ligne de ma colonne contenant la date du jour

Voilà ce que j'ai fait pour le moment mais je bloque sur la méthode range

Sub copie_rang()

Dim wsSource As Worksheet, wsDest As Worksheet

Dim r As Range
Dim col As Integer
Dim datej As String

Set wsSource = ThisWorkbook.Sheets("Stats a N")
Set wsDest = ThisWorkbook.Sheets("classement_boutiques_Juin")

datej = Date

Set r = Rows(1).Find(datej, , xlValues, xlWhole)
If Not r Is Nothing Then col = r.Column

For Each cell In wsDest.Range("A1:1" & wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row)
        If IsDate(cell.Value) And cell.Value = datej Then
                    cell.Offset(0, 1).Value = wsSource.Range("C2").Value
            Exit For ' Sortir de la boucle une fois trouvé
        End If
    Next cell
End Sub

Merci

Bonjour,

Votre code est un peu en contradiction avec votre explication : vous dites vouloir coller dans "la première ligne de ma colonne contenant la date du jour", que vous trouvez à l'aide de la méthode find (c'est très bien) Set r = Rows(1).Find(datej, , xlValues, xlWhole), mais ensuite le code boucle sans que l'on comprenne pourquoi...

Pour respecter scrupuleusement votre énoncé, le code suivant devrait suffire :

Sub copie_rang()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim r As Range
    Dim datej As String

    Set wsSource = ThisWorkbook.Sheets("Stats a N")
    Set wsDest = ThisWorkbook.Sheets("classement_boutiques_Juin")

    datej = Date
    Set r = wsDest.Rows(1).Find(datej, , xlValues, xlWhole)
    If Not r Is Nothing Then
        r.Value = wsSource.Range("C2").Value
    Else
        MsgBox "Date non trouvée dans la ligne 1."
    End If
End Sub

A la limite pour ne pas copier "dans la 1e ligne" et donc SUR la date, on peut utiliser

r.Offset(1).Value = wsSource.Range("C2").Value

Mais pas besoin de boucler, Find vous renvoi directement la bonne colonne.

Merci pour votre retour, content d'aider.

N'oubliez pas de clôturer, bonne journée.