Forum Discussion
Copy entire row to another sheet when either one of two criteria is met
It's my fault - sorry about that.
I used "NonComformitySchedule" in the code instead of "NonConformitySchedule". Please change this in the line Set wsh = Worksheets(...)
Hi Hans, Firstly, thank you so much for your reply.
The data rows on source sheet "AuditChecklist" start at A10 and need to be copied to Rows starting at A10 on Recipient sheet "NonConformitySchedule".
The criteria column is H for either M or R entry.
**Note: column H will have several entries but im only interested in copying rows with either M or R entered into column H.
Hopefully the entire rows worth of data will be copied to the recipient sheet based on either M or R entry into column H.
I cannot thank you enough, I hope you can help
Richard
Right-click the sheet tab of AuditChecklist.
Select 'View Code' from the context menu.
Copy the following code into the worksheet module (Edited to correct typo😞
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsh As Worksheet
Dim rng As Range
If Not Intersect(Range("H10:H" & Rows.Count), Target) Is Nothing Then
Set wsh = Worksheets("NonConformitySchedule")
For Each rng In Intersect(Range("H10:H" & Rows.Count), Target)
Select Case rng.Value
Case "M", "R"
rng.EntireRow.Copy Destination:=wsh.Range("A" & rng.Row)
Case Else
' Do nothing
End Select
Next rng
Application.CutCopyMode = False
End If
End Sub
Switch back to Excel.
Save the workbook as a macro-enabled workbook (*.xlsm) and make sure that you allow macros when you open it.
Hi Hans,
This is nearly perfect for me but would there be a way to make the macro remove the copied row again from the destination sheet if i removed the M or R from the source sheet?
Hi Hans,
This is perfect for what i need but i am hoping you can extend it a little?
Is there a way to delete the row again if M or R are removed? the idea being that when a job is completed i can remove the M or R and it will remove the copied row from the destination sheet?
It would be a huge help
Right-click the sheet tab of the NonComformitySchedule sheet.
Select View Code.
Paste the following code into the worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range) Dim wsh As Worksheet Dim rng As Range Dim rngDelete As Range If Not Intersect(Range("H10:H" & Rows.Count), Target) Is Nothing Then Set wsh = Worksheets("NonConformitySchedule") For Each rng In Intersect(Range("H10:H" & Rows.Count), Target) If rng.Value = "" Then If rngDelete Is Nothing Then Set rngDelete = rng Else Set rngDelete = Union(rng, rngDelete) End If End If Next rng If Not rngDelete Is Nothing Then rngDelete.EntireRow.Delete End If End If End Sub
- HI Hans,
It is telling me that there is a Run-time error '424' and object required on the
" If Not Intersect(Range("H10........ line
thank you anyways for your time and effort, i am most grateful 🙂
Kindest regards
RichardThat is strange - the code works when I try it. Could you attach a copy of the workbook demonstrating the problem? Don't include any sensitive/proprietary information.
HI Hans,
Thank you for this, please find attached the workbook.
kindest regards
Richard
