So I tried using the code you provided, in the original file I need the macro to work in, and tweaked some of your code to match one or two changes I made (i.e. data to be copied is in another cell and renamed tab) [see below in red] and it doesn't appear to work now. Is there something else I should have changed/updated? I've attached another sample showing what the master file looks like now.
Public Sub Transfer_Data()
Dim End_Of_Week_Date As Date, EOW_Found As Range
'Determine the end of this week (next Friday)
'If we are on weekend, then Friday of next week
If Weekday(Now(), vbMonday) <= 5 Then
End_Of_Week_Date = Now() + 5 - Weekday(Now(), vbMonday)
Else
End_Of_Week_Date = Now() + 12 - Weekday(Now(), vbMonday)
End If
End_Of_Week_Date = DateSerial(Year(End_Of_Week_Date), Month(End_Of_Week_Date), Day(End_Of_Week_Date))
'
'Locating the column to transfer the data
Set EOW_Found = Sheets("Table").Rows(3).Find(End_Of_Week_Date)
'If we found the right column then transfer data
If Not EOW_Found Is Nothing Then
EOW_Found.Offset(9, 0) = Range("A12")
EOW_Found.Offset(9 + 14, 0) = Range("A26")
EOW_Found.Offset(9 + 28, 0) = Range("A40")
EOW_Found.Offset(9 + 42, 0) = Range("A54")
EOW_Found.Offset(9 + 56, 0) = Range("A68")
EOW_Found.Offset(9 + 70, 0) = Range("A82")
End If
End Sub
copy&paste in next blank cell2.xlsm
Bookmarks