@Jarvo
Place the following codes on the Sheet Modules as below...
Codes for Current Sheet Module:
Private Sub Worksheet_Activate()
Dim wsArchive As Worksheet
Dim lr As Long
Dim i As Long
Dim dlr As Long
Dim rng As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo Skip
Set wsArchive = ThisWorkbook.Worksheets("Archive")
lr = wsArchive.Cells(Rows.Count, "D").End(xlUp).Row
For i = 4 To lr
If wsArchive.Cells(i, "D") = "Open Risks" Then
Set rng = wsArchive.Range("A" & i & ":G" & i)
dlr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
rng.Copy Range("A" & dlr)
rng.Delete
End If
Next i
Skip:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tbl As ListObject
Dim rng As Range
Dim dws As Worksheet
Dim dlr As Long
Application.ScreenUpdating = False
On Error GoTo Skip
Set tbl = ActiveSheet.ListObjects("Table1")
If Not Intersect(Target, tbl.DataBodyRange.Columns(4)) Is Nothing Then
Application.EnableEvents = False
Set rng = Intersect(ActiveSheet.Rows(Target.Row), Columns("A:G"))
rng.Copy
Select Case Target.Value
Case "Save"
Set dws = ThisWorkbook.Worksheets("Saved")
Case "Closed"
Set dws = ThisWorkbook.Worksheets("Archive")
End Select
dlr = dws.Cells(Rows.Count, "D").End(xlUp).Row + 1
dws.Range("A" & dlr).PasteSpecial xlPasteAll
Rows(Target.Row).Delete
End If
Skip:
Application.CutCopyMode = 0
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Codes for Saved Sheet Module:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myDateTimeRange As Range
If Target.Column <= 7 And Target.Row > 3 Then
'Stop events from running
Application.EnableEvents = False
'Column for the date/time
Set myDateTimeRange = Range("T" & Target.Row)
'Column for last updated date/time
'Determine if the input date/time should change
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
'Update the updated date/time value
'Turn events back on
Application.EnableEvents = True
End If
End Sub
Codes for Archive Sheet Module:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsSaved As Worksheet
Dim myDateTimeRange As Range
Dim r As Long
Dim dlr As Long
Dim rng As Range
On Error GoTo Skip
Application.ScreenUpdating = False
Set wsSaved = ThisWorkbook.Worksheets("Saved")
'Stop events from running
Application.EnableEvents = False
If Target.Column = 4 And Target.Row > 3 Then
If Target.Value = "Save" Then
r = Target.Row
dlr = wsSaved.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Set rng = Range("A" & r & ":G" & r)
rng.Copy wsSaved.Range("A" & dlr)
End If
ElseIf Target.Column <= 7 And Target.Row > 3 Then
'Column for the date/time
Set myDateTimeRange = Range("T" & Target.Row)
'Column for last updated date/time
'Determine if the input date/time should change
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
End If
Skip:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
As per the Worksheet_Activate Code on Current Sheet Module, once you change the status of a risk in to Open Risks (in column D on Archive Sheet) and you select the Current Sheet, the risk for which you changed the status on Archive Sheet as Open Risks, will be transferred to the Current Sheet automatically and will be deleted from Archive Sheet.
Similarly when you change the status of a risk to Save on Archive Sheet, that row will be copied to the Saved Sheet without deleting that row on Archive Sheet.
I have placed all the codes on the Sheet Modules for you to test it.
