Sub WeeklySummary()
Dim Wk As String
Dim rowSum As Range, colSum As Range
Dim rngSumRegion As Range, rngSumCol As Range
Dim rowData As Range, colData As Range
Dim rngDataRegion As Range, rngDataCol As Range
Dim wsSummary As Worksheet, wsData As Worksheet
Set wsSummary = ActiveWorkbook.Sheets("Sheet1")
Set wsData = ActiveWorkbook.Sheets("Sheet2")
Set rngSumRegion = wsSummary.Range("A2", wsSummary.Range("A1").End(xlDown).Offset(-1, 0))
Set rngSumCol = wsSummary.Range("B1", wsSummary.Cells(1, Columns.Count).End(xlToLeft))
Set rngDataRegion = wsData.Range("A2", wsData.Range("A1").End(xlDown).Offset(-1, 0))
Set rngDataCol = wsData.Range("B1", wsData.Cells(1, Columns.Count).End(xlToLeft).Offset(0, -1))
For Each colData In rngDataCol
Set colSum = rngSumCol.Find("Wk" & GetWk(colData.Text))
For Each rowData In rngDataRegion
Set rowSum = rngSumRegion.Find(rowData)
wsSummary.Cells(rowSum.Row, colSum.Column) = wsSummary.Cells(rowSum.Row, colSum.Column) + wsData.Cells(rowData.Row, colData.Column)
Next
Next
End Sub
Function GetWk(dt As Date) As Long
Select Case Day(dt)
Case 1 To 7
GetWk = 1
Case 8 To 14
GetWk = 2
Case 15 To 21
GetWk = 3
Case 22 To 28
GetWk = 4
Case Is > 28
GetWk = 5
End Select
End Function