K
KevHardy
Hi,
I am currently using the code below to copy a row of datat to the next sheet
and then delete the old data. This works perfectly until the workbook is
shared after which the delete part fails to work (but doesn't return an
error).
I have posted questions regarding this but the best brains have been unable
to replicate the error so have been unable to help.
I am therefore asking if anyone can rewrite this code using a different
method which I can then try to see if it will work.
Current code is:
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "J:J" 'This is the colum that runs the macro
Dim rng1 As Range
Dim rng2 As Range
If Target.Cells.Count > 1 Then
Exit Sub 'single cell at a time
End If
If Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Exit Sub
End If
Set rng1 = Target.EntireRow.Range("A1:J1") 'The range A1:J1 ensures the
copied data doesn't overwrite formatting on next sheet in columns K:L:M
With Worksheets("outcomes")
Set rng2 = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
On Error GoTo ws_exit:
Application.EnableEvents = False
If Target.Value <> "" Then
With rng1
..Copy _
Destination:=rng2
..Delete Shift:=xlUp
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Any help would be most welcome
I am currently using the code below to copy a row of datat to the next sheet
and then delete the old data. This works perfectly until the workbook is
shared after which the delete part fails to work (but doesn't return an
error).
I have posted questions regarding this but the best brains have been unable
to replicate the error so have been unable to help.
I am therefore asking if anyone can rewrite this code using a different
method which I can then try to see if it will work.
Current code is:
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "J:J" 'This is the colum that runs the macro
Dim rng1 As Range
Dim rng2 As Range
If Target.Cells.Count > 1 Then
Exit Sub 'single cell at a time
End If
If Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Exit Sub
End If
Set rng1 = Target.EntireRow.Range("A1:J1") 'The range A1:J1 ensures the
copied data doesn't overwrite formatting on next sheet in columns K:L:M
With Worksheets("outcomes")
Set rng2 = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
On Error GoTo ws_exit:
Application.EnableEvents = False
If Target.Value <> "" Then
With rng1
..Copy _
Destination:=rng2
..Delete Shift:=xlUp
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Any help would be most welcome