Добавление столбцов таблицы в соседние столбцы каждое воскресенье и очистка данных в первом наборе

Question

введите описание изображения здесь Я хочу взять диапазон из двух столбцов (значения данных из «этой недели») из именованного диапазона, добавить его в два соседних столбца (значения из «предыдущих недель»)) в названном диапазоне.Затем мне нужны два столбца для значений этой недели, которые будут очищены на предстоящую неделю.Однако я хочу, чтобы этот код выполнялся только один раз в конце недели (используя воскресенье в качестве конца недели).

Итак, в основном, я пишу программу, которая отслеживает рабочие часы / расходуемые материалы и сравнивает их с оценкой / анализом данных.Я смог понять большую часть того, что мне нужно сделать, но я все время нахожусь в тупике из-за этого

Ничто из того, что я сделал, не было успешным.Я попытался сделать изменение листа и вычислить лист, но безрезультатно.Вот большая часть моего кода:

Public Function JTD() As Variant()                          ''same as above 
function but makes array of job to date columns
 Dim ws As Worksheet
 Set ws = Worksheets("Sheet1")
Dim rRows As Integer
  rRows = Module1.countRows(ws)
Dim lastCell
Dim firstCell
  Set firstCell = ws.Cells(4, 25)
  Set lastCell = ws.Cells(rRows, 26)
Dim jobTD()
  jobTD = ws.Range(firstCell, lastCell)
    JTD = jobTD
End Function

Function ArrayAdd(A, B)                                             
    ArrayAdd = Application.Pmt(, -1, A, B)
End Function

Public Sub emptyThsWk()                                         
  Dim last As Integer
  Dim ws As Worksheet
  Set ws = Worksheets("Sheet1")
   last = Module1.countRows(ws)
 With ws
   Range(Cells(4, 23), Cells(last, 24)).Select          ''selects range down to the last cost code and clears selection
    Selection.ClearContents
 End With
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)                 ''worksheet change event that should be triggered every time the week end date changes, adding all this week numbers to previous JTD then calling the above 
clear thsWk function
Dim prvWk()
Dim jtdOld()
Dim jtdNew()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Dim rRow As Integer
 rRow = Module1.countRows(ws)
   If Not Application.Intersect(Target, Worksheets("Sheet1").Cells(2, 24)) 
Is Nothing Then           ''check if there is change to cell with week end 
date in it
    prvWk = Sheet1.thWk                             'set array equal to 
this weeks values
    jtdOld = Sheet1.JTD                             'set array equal to JTD values
      jtdNew = ArrayAdd(prvWk, jtdOld)              'add the two arrays to make a new array
        Range(Cells(4, 25), Cells(rRow, 26)) = jtdNew   ' set new array equal to job to date columns
     Call Sheet1.emptyThsWk                 ''call func to empty this weeks cells
  End If

End Sub