Macro Needed To Move Specific Row To a Specific Worksheet Based On Criteria

[CONFUSED_AS_USUAL]

Hi,

I would like a macro that would:

1. Search for specific exact text in a specific column (often will be multiple matches).

2. If it encounters an exact match in that specific column, it will move the complete row to another specific worksheet (to be placed at the next available row that is not populated).

This is to cycle through until it encounters no more data.

Thanks.

 

[My Aswer Is This]

Since you did not provide any exact details like we always want try this:
This script assumes the two sheet names are “CopyFrom” and “CopyTo”
And the column to search is column “A”
If this is not correct then modify the script where marked in red.
This script has a inputbox where you need to enter the value to search for.
And you said “move” but I assume to mean copy. Did you want the original row in sheet “CopyFrom” deleted ?

Sub Copy_Match()
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Col As String
Dim One As String
Dim Two As String
[/COLOR]One = "[COLOR=#ff0000]CopyFrom[/COLOR]" 'Change sheet name here
Two = "[COLOR=#ff0000]CopyTo[/COLOR]" 'Change sheet name here
Col = "[COLOR=#ff0000]A[/COLOR]" ' Change Column to search here
[COLOR=#000000]Dim Lastrow As Long
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Dim Lastrowa As Long
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
ans = InputBox("Enter value to search for")
    For i = 1 To Lastrow
        If Sheets(One).Cells(i, Col).Value = ans Then Rows(i).Copy Sheets(Two).Rows(Lastrowa): Lastrowa = Lastrowa + 1
    Next
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Problems with this Forum Today.
Try this:

Since you did not provide any exact details like we always want try this:
This script assumes the two sheet names are “CopyFrom” and “CopyTo”
And the column to search is column “A”
If this is not correct then modify the script where marked in red.
This script has a inputbox where you need to enter the value to search for.
And you said “move” but I assume to mean copy. Did you want the original row in sheet “CopyFrom” deleted ?

Sub Copy_Match()
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Col As String
Dim One As String
Dim Two As String
One = "[COLOR=#ff0000]CopyFrom[/COLOR]" 'Change sheet name here
Two = "[COLOR=#ff0000]CopyTo[/COLOR]" 'Change sheet name here
Col = "[COLOR=#ff0000]A[/COLOR]" ' Change Column to search here
Dim Lastrow As Long
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Dim Lastrowa As Long
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
ans = InputBox("Enter value to search for")
    For i = 1 To Lastrow
        If Sheets(One).Cells(i, Col).Value = ans Then Rows(i).Copy Sheets(Two).Rows(Lastrowa): Lastrowa = Lastrowa + 1
    Next
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

edit

 

[My Aswer Is This]

Or try this script using filter:
Modify sheet names and column as needed.
See items marked in red to make changes

Sub Auto_Filter_This_New()
Application.ScreenUpdating = False
Dim Col As Long
Dim One As String
Dim Two As String
One = "[COLOR=#ff0000]CopyFrom[/COLOR]" 'Change sheet name here
Two = "[COLOR=#ff0000]CopyTo[/COLOR]" 'Change sheet name here
Col = "[COLOR=#ff0000]1[/COLOR]" ' Change Column to search here
Sheets(One).Rows(1).Copy Sheets(Two).Rows(1)
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
Dim ans As String
ans = InputBox("Enter value to search for")
    
    With Worksheets(One).Rows("1:" & Lastrow)
        .AutoFilter
        .AutoFilter Field:=Col, Criteria1:=ans
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(Two).Range("A" & Lastrowa)
    End With
    
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

2. ... it will move the complete row to another specific worksheet ...

Just to clarify: Does that mean the row is to be removed from the original sheet, or just that a copy is made in the destination sheet?

 

[My Aswer Is This]

Yes I already asked that question.

Just to clarify: Does that mean the row is to be removed from the original sheet, or just that a copy is made in the destination sheet?

 

[Peter_SSs]

Yes I already asked that question.

You did indeed, I had missed that.

 

[CONFUSED_AS_USUAL]

This works Perfectly Peter. Clear instructions to the initiated.

To answer your question that I was not clear on.... Yes, I would like the row(s) removed from the original sheet please.

Thanks.

Just to clarify: Does that mean the row is to be removed from the original sheet, or just that a copy is made in the destination sheet?

 

[My Aswer Is This]

Assuming your using the code I wrote even though your comments were directed to Peter.

Try this script. It will delete the rows also:

Sub Auto_Filter_This_New()
Application.ScreenUpdating = False
'Modified 8-28-17 3:14 PM EDT
Dim Col As Long
Dim One As String
Dim Two As String
One = "CopyFrom" 'Change sheet name here
Two = "CopyTo" 'Change sheet name here
Col = "1" ' Change Column to search here
Sheets(One).Rows(1).Copy Sheets(Two).Rows(1)
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
Dim ans As String
ans = InputBox("Enter value to search for")
    
    With Worksheets(One).Rows("1:" & Lastrow)
        .AutoFilter
        .AutoFilter Field:=Col, Criteria1:=ans
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(Two).Range("A" & Lastrowa)
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    
    
    End With
    
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub