Copy-Paste-Find-Replace (weekly update) Heres a code that update weekly datas from production reports
Known flaws :

Im copy pasting the old line and replacing the week number in it to fit it to the one we want to update. The problem is that its not taking in account if cell emplacement of the data is changing.
I also tought it was simpler than re-writing all formulas in every-cell by coding every bits of formula (file emplacement, file name and cell emplacement changes every ranges)
Should i call my action if true in another sub to make this clearer?
(ex: if true, call(copy-paste-find-replace)
I have 1 code per sheet (3 sheets) cause of the ranges are hard coded and changes depending on the sheets, with your answer to (1) i could make it a single sub with variables depending on the sheet
I have a week and a half remaining to make this as clean as possible, i dont want to refactor it all the way .. :(

Heres one of the 3 code :
Sub AjoutSemaineajouterperfo()
    ' AjoutSemaineajouterperfo Macro
    ' Le code permet d'ajouter une nouvelle Semaineajouteraine

    Dim k As Long
    k = 3

    Do While (Cells(k, 3).Value &lt;&gt; &quot;&quot; And k &lt;= 53) ' Boucle qui trouve la première ligne Semaineajouteraine vide
        k = k + 1
    Loop

    k = k - 2                                    ' La boucle while ajoute une Semaine de trop, on veut aussi revenir sur la dernière semaine rentrer (d'ou le -2)

    Dim Semaineajouter As Long
    Dim Destination As Long
    Dim Semaineavant As Long
    Semaineajouter = Cells(59, 3).Value          ' Valeur de la semaine à ajouter(case)
    Destination = Semaineajouter + 1             ' Ligne ou la prochaine semaine va se coller
    Semaineavant = Semaineajouter - 1            ' Ligne de la dernière semaine importer

    Dim semaineactuelle As Long
    semaineactuelle = WorksheetFunction.WeekNum(Now, vbMonday)

    If Semaineajouter &gt; k And Semaineajouter &lt;= 52 And Semaineajouter &lt;&gt; semaineactuelle Then
        ' Si le numéro de Semaineajouteraine entrée est plus grand que la dernière semaine ajouté  et différent de la semaine actuelle
        ' Aussi plus petit que 52 (préserver la mise en forme

        Application.EnableEvents = False
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        ActiveSheet.Unprotect
    
        Dim semaineajoutertex As String
        Dim semaineavanttex As String
        semaineajoutertex = &quot;sem &quot; &amp; CStr(Semaineajouter) ' Transfert des numéros de semaine en texte (pour search and replace)
        semaineavanttex = &quot;sem &quot; &amp; CStr(Semaineavant)
    
        ' Range 1
        Dim RangeOrigine1 As String
        RangeOrigine1 = &quot;C&quot; &amp; Semaineajouter &amp; &quot;:&quot; &amp; &quot;AX&quot; &amp; Semaineajouter ' Range d'origine (semaine avant)
        Dim RangeDestination1 As String
        RangeDestination1 = &quot;C&quot; &amp; Destination &amp; &quot;:&quot; &amp; &quot;AX&quot; &amp; Destination ' Range à importer (semaine ajout)
    
        Range(RangeOrigine1).Copy Range(RangeDestination1)
    
        Range(RangeDestination1).Replace What:=semaineavanttex, Replacement:=semaineajoutertex, LookAt:=xlPart, _
                                         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                                         ReplaceFormat:=False
   
        ActiveSheet.Protect
        
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        
    Else
        MsgBox &quot;Entrez un numéro de Semaineajouteraine valide&quot;, vbCritical, &quot;Ne peut exécuter&quot;
    End If

End Sub


In this case, pressing GO would call the macro and add week 33 by copy-pasting-find-replace the line from week 32, replacing &quot;sem 32&quot; by &quot;sem 33&quot; in every
newly paste entries.
I don't see the need to find a specific row number.  Simply work your way down until you reach the current week.
The key to reducing repeat code is to extract it to it's own method.
Refactored Code
Sub UpdateWeeklyReports()
    Application.ScreenUpdating = False
    Const WorksheetName As String = &quot;Sheet1&quot;
    Const FirstWeekNumberRow As Long = 3
    Dim LastWeek As Range
    Dim What As String, Replacement As String
    With Worksheets(WorksheetName)
        Dim Row As Long
        For Row = FirstWeekNumberRow + 1 To  Format(Now, &quot;WW&quot;) - 1
            If Not .Cells(Row, 3).HasFormula Then
                ' What = &quot;sem &quot; &amp; .Cells(Row - 1, 2).Value
                ' Replacement = &quot;sem &quot; &amp; .Cells(Row, 2).Value
                AddNewRow SourceRange:=.Rows(Row - 1).Range(&quot;C1:J1&quot;), What:=What, Replacement:=Replacement
                AddNewRow SourceRange:=.Rows(Row - 1).Range(&quot;M1:T1&quot;), What:=What, Replacement:=Replacement
                AddNewRow SourceRange:=.Rows(Row - 1).Range(&quot;W1:AD1&quot;), What:=What, Replacement:=Replacement
            End If
        Next
    End With
End Sub

Private Sub AddNewRow(ByVal SourceRange As Range, ByVal What As String, ByVal Replacement As String)
    With SourceRange
        .Offset(1).Formula = .Formula
        .Offset(1).Replace What:=What, Replacement:=Replacement, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    End With
End Sub