Moving range to onther sheetbase on cell value

[khaledocom]

Hi all,

In the attached file I need a code to move a range("B:M") once related "L" cell ="ok" to sheet2 (First blank row), then delete origin in sheet1.

Note:
If I run macro again after moving and there's no "ok" no change should happen in either sheet1 or sheet2.

[Aussiebear]

Do you wish to have the macro run down the Column from L2 to end of data in one move or the macro to be activated once the string value "Ok" is entered into any cell in range L2 to end of column?

[khaledocom]

Yes, the macro to take part once the cell in column L="ok" then
subject row to be moved to sheet2, and deleted in sheet1.

Thanks for your help.

[Aussiebear]

Try the following;

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Column = 12 And Target.Row > 1 Then
If Target = "Ok" Then DoClear Target
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
On Error Resume next
End Sub

Sub DoClear(Target As Range)
Dim lRow As Long
Dim cRow As Long
lRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
With ActiveSheet
Range(.Cells(Target.Row, 2), .Cells(Target.Row, 13)).Copy
With Sheets ("Sheet2")
.Range(.Cells(lRow, 2), .Cells(lRow, 13)).PasteSpecial xlValues
End With
Application.CutCopyMode = False
End With
.Range("B" & cRow & ":M" & cRow).Delete
End Sub

[khaledocom]

I tried the above code but it's not working.

[shrivallabha]

The code provided by Aussiebear is worksheet change type. So have you pasted the code in worksheet module? i.e. right click on the sheet1, there will be an option "View Code". Click it and paste above code.

One more thing, it will fire when you change the data in the sheet1.

[khaledocom]

I did as you said exactly in the above attached file but it didn't work.

[shrivallabha]

Try with this edited code and see if it works:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
If Target.Column = 12 And Target.Row > 1 Then
If UCase(Target.Value) = "OK" Then DoClear Target
End If
Application.ScreenUpdating = True
On Error Resume Next
End Sub

Sub DoClear(Target As Range)
Dim cRow As Long
With ActiveSheet
Range(.Cells(Target.Row, 2), .Cells(Target.Row, 13)).Copy
.Paste Destination:=Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp)(2)
Application.CutCopyMode = False
.Rows(Target.Row).Delete
End With
End Sub

[khaledocom]

Not working my dear friend, thanks again Shrivallabha

[BrianMH]

Sorry to ask this. Have you definately got macros enabled?