Trouver adresse mot et le coller sur d'autres feuilles

Bonjour,

Je sèche sur un problème. Le nom des onglets de mon fichier sont des années (2009,2010,...etc).

Je voudrais rechercher un mot se trouvant sur la 1ère feuille (ex 2009), ce mot figurent plusieurs fois sur la feuille.

Une fois trouvé le réécrire sur toutes les autres feuilles à la même adresse ( si le mot est en A8, il sera mis en A8 sur toutes les feuilles).

Je me suis inspiré d'un code trouvé sur ce forum ou le net, je ne me souviens plus exactement.

Il utilise Find et FindNext, mais je coince sur ce que je viens d'expliquer.

Option Explicit
Sub MiseAJour()
    Dim Cel As Range, myRange As Range
    Dim Ws As Object, F As Worksheet
    Set F = Worksheets("2014")

    For Each Ws In ThisWorkbook.Sheets
        If Ws.Name <> "2014" Then
            With Ws.Name    'Sheets(1)
                Set Cel = F.UsedRange.Find(what:="x", LookIn:=xlValues, LookAt:= _
                                           xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                        , SearchFormat:=False)
                If Not Cel Is Nothing Then
                    Set myRange = Cel
                    'myRange.Address
                    .Cel.Address = Cel.Value
 Do
                        Set Cel = F.UsedRange.FindNext(Cel)
                        .Cel = myRange    '.Select
                    Loop While Cel.Address <> myRange.Address
                End If
            End With
        End If
    Next Ws
  End Sub

En vous remerciant.

bonsoir,

proposition de correction

Option Explicit
Sub MiseAJour()
    Dim Cel As Range, myRange As Range
    Dim Ws As Object, F As Worksheet
    Set F = Worksheets("2014")

    For Each Ws In ThisWorkbook.Sheets
        If Ws.Name <> "2014" Then
            With Ws    'Sheets(1)
                Set Cel = F.UsedRange.Find(what:="x", LookIn:=xlValues, LookAt:= _
                                           xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                                                                                                              , SearchFormat:=False)
                If Not Cel Is Nothing Then
                    Set myRange = Cel
                    'myRange.Address
                    .Range(Cel.Address) = Cel.Value
                    Do
                        Set Cel = F.UsedRange.FindNext(Cel)
                        .Range(Cel.Address) = myRange    '.Select
                    Loop While Cel.Address <> myRange.Address
                End If
            End With
        End If
    Next Ws
End Sub

Bonjour H2So4

C'est parfait. Exactement ce que je cherchais à obtenir.

Toute ma gratitude.