Copy-Paste-Find-Replace (weekly update)

Question

Heres a code that update weekly datas from production reports

Known flaws :

1. 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)
2. Should i call my action if true in another sub to make this clearer? (ex: if true, call(copy-paste-find-replace)
3. 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
4. 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 <> "" And k <= 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 > k And Semaineajouter <= 52 And Semaineajouter <> 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 = "sem " & CStr(Semaineajouter) ' Transfert des numéros de semaine en texte (pour search and replace)
 semaineavanttex = "sem " & CStr(Semaineavant)
 
 ' Range 1
 Dim RangeOrigine1 As String
 RangeOrigine1 = "C" & Semaineajouter & ":" & "AX" & Semaineajouter ' Range d'origine (semaine avant)
 Dim RangeDestination1 As String
 RangeDestination1 = "C" & Destination & ":" & "AX" & 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 "Entrez un numéro de Semaineajouteraine valide", vbCritical, "Ne peut exécuter"
 End If
End Sub

In window data sample

In this case, pressing GO would call the macro and add week 33 by copy-pasting-find-replace the line from week 32, replacing "sem 32" by "sem 33" in every newly paste entries.

• HackSlash: Step one is to fix the formatting of your code. The VBA Rubberduck can correctly format your code for you: rubberduckvba.com
• Patates Pilées: Cant add it to my job excel without askin the IT guys, may take a week or so...
• HackSlash: you can install in user mode without administrator.
• Patates Pilées: Ok so il remind myself to always try before saying it dosn't work; its done now, thx Hack!
• TinMan: Sample data would help.

Answer 1

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 = "Sheet1"
 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, "WW") - 1
 If Not .Cells(Row, 3).HasFormula Then
 ' What = "sem " & .Cells(Row - 1, 2).Value
 ' Replacement = "sem " & .Cells(Row, 2).Value
 AddNewRow SourceRange:=.Rows(Row - 1).Range("C1:J1"), What:=What, Replacement:=Replacement
 AddNewRow SourceRange:=.Rows(Row - 1).Range("M1:T1"), What:=What, Replacement:=Replacement
 AddNewRow SourceRange:=.Rows(Row - 1).Range("W1:AD1"), 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