as the date in B2 will always be a friday (the end of a week) the macro will be simpler
Public Sub Transfer_Data()
Dim EOW_Found As Range
'
'Locating the column to transfer the data
Set EOW_Found = Sheets("Sheet1").Rows(3).Find(Range("B2"))
'If we found the right column then transfer data
If Not EOW_Found Is Nothing Then
EOW_Found.Offset(9, 0) = Range("A13")
EOW_Found.Offset(9 + 14, 0) = Range("A27")
EOW_Found.Offset(9 + 28, 0) = Range("A41")
EOW_Found.Offset(9 + 42, 0) = Range("A55")
EOW_Found.Offset(9 + 56, 0) = Range("A69")
EOW_Found.Offset(9 + 70, 0) = Range("A83")
End If
End Sub
Bookmarks