transfer complete rows to new sheet

[slochin]

Hello,
I am hoping someone can assist meplease with my project.
I have two sheets with info incolumns .
In sheet one the info spreads fromA-N. In col S and T “yes” is placed if certain criteria is met.
In sheet two info spreads from A-Q.In col R if certain criteria is met a “yes” is inserted.
What I would like to do is to beable to transfer the complete row if “yes” is in the columns asabove and place them in a new sheet.

 

[mumps]

Does "Yes" have to be in both columns S and T in order to transfer the row or in just one of the 2 columns? Also, by "transfer" do you mean "copy" or "move"?

 

[slochin]

Hello mumps, Thanks for prompt reply.
"yes" only has to be in either ColS or T to require copy.I wish to have the full row of each sheet that has "Yes" in copied and pasted in a new sheet.

 

[mumps]

Copy and paste these macro into the worksheet code modules. Do the following: right click the tab for Sheet1 and click 'View Code'. Paste the first macro into the empty code window that opens up. Close the code window to return to your sheet. Next right click the tab for Sheet2 and click 'View Code'. Paste the second macro into the empty code window that opens up. Close the code window to return to your sheet. Make sure that you have a sheet named "Sheet3". Enter "Yes" in the appropriate columns and exit the cell. That row will be copied to Sheet3.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("S:S,T:T")) Is Nothing Then Exit Sub
    If Target = "Yes" Then
        Target.EntireRow.Copy Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("R:R")) Is Nothing Then Exit Sub
    If Target = "Yes" Then
        Target.EntireRow.Copy Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
End Sub

 

[slochin]

Hello mumps,
Reallyappreciate your assistance. I think the hitch might be because I didnot explain it clearly enough.
What I have done so far is firstly copyand paste my data into a new workbook. Now if I type a Yes in thecolumns the code works as expected.
I would not normally type in the yes.What I have in the columns S and T in sheet 1,and Col R in sheet 2are excel formulas such as ,=IF(M2+N2>150%,"Yes",""),whichcheck the criteria and automatically then place a Yes if the criteriais met.
This then seems to create an issue aswhen I try this I receive a runtime error 13,type mismatch and whenchecking debug it highlights if target =”Yes”then.
One again thank you for yourassistance.

 

[mumps]

Unfortunately, a Worksheet_Change macro such as this one will not be triggered by the result of a formula. The change has to be done manually. We could change the macro so that it can be run manually each time you want to update the destination sheet after the formulas have returned a "Yes". If this will work for you, I would need to know the actual sheet names of the 2 source sheets and the destination sheet.

 

[slochin]

Hello mumps,
Thank you for explaining this.I think this will work,the 2 source sheets being Sheet1,Sheet2, and the destination Sheet3.

 

[mumps]

Run this macro each time you want to update Sheet3.

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim ws As Worksheet
    For Each ws In Sheets(Array("Sheet1", "Sheet2"))
        ws.UsedRange.ClearContents
    Next ws
    For Each rng In Sheets("Sheet1").Range("S2:S" & LastRow)
        If rng = "Yes" Or rng.Offset(0, 1) = "Yes" Then
            rng.EntireRow.Copy Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next rng
    LastRow = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In Sheets("Sheet2").Range("R2:R" & LastRow)
        If rng = "Yes" Then
            rng.EntireRow.Copy Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

If Sheet3 has headers in row 1 then replace this line of code:

ws.UsedRange.ClearContents

with this line:

ws.UsedRange.Offset(1,0).ClearContents

 

[slochin]

Hello mumps,
When I run this macro I receive this message,object variable or with block variable not set.
It clears all data from Sheet1 and Sheet2.

 

[mumps]

Try:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Sheets("Sheet3").UsedRange.ClearContents
    For Each rng In Sheets("Sheet1").Range("S2:S" & LastRow)
        If rng = "Yes" Or rng.Offset(0, 1) = "Yes" Then
            rng.EntireRow.Copy Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next rng
    LastRow = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In Sheets("Sheet2").Range("R2:R" & LastRow)
        If rng = "Yes" Then
            rng.EntireRow.Copy Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

If you still get an error message, let me know what the error is and which line of code is highlighted when you click 'Debug'.