Where "Motel" appears in Column A, move that row to sheet 2

Excel file example contains 10 columns.
The request is that for all rows where "Motel" is in column A, these rows are moved to Sheet2.
EE-Example.xlsx
gregfthompsonAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You may try something like this...
Sub CopyToMotelData()
Dim sws As Worksheet, dws As Worksheet
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")
dws.Cells.Clear
With sws.Range("A1").CurrentRegion
    .AutoFilter field:=1, Criteria1:="*Motel*"
    .SpecialCells(xlCellTypeVisible).Copy dws.Range("A1")
    .AutoFilter
End With
sws.Range("A1:J1").Copy
dws.Range("A1").PasteSpecial xlPasteColumnWidths
dws.Select
dws.Range("A1").Select
Application.ScreenUpdating = True
End Sub

Open in new window

In the attached, click the button called "Copy Motel Data" on Sheet2 to run the code.
EE-Example.xlsm
gregfthompsonAuthor Commented:
Thanks Subodh.
Can you revise to delete the  "Motel" row from Sheet1?

Thanks,
Greg
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Greg!

Please try it like this...

Sub CopyToMotelData()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long
Dim Ans As VbMsgBoxResult

Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")
lr = sws.Range("A1").CurrentRegion.Rows.Count
With sws.Range("A1").CurrentRegion
    .AutoFilter field:=1, Criteria1:="*Motel*"
    If sws.Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        dws.Cells.Clear
        .SpecialCells(xlCellTypeVisible).Copy dws.Range("A1")
        sws.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Else
        Ans = MsgBox("There was no matching data found on Sheet1" & vbNewLine & vbNewLine & _
                    "Do you want to clear the existing data on Sheet2?", vbQuestion + vbYesNo, "Confirm Please!")
        If Ans = vbYes Then dws.Cells.Clear
    End If
    .AutoFilter
End With
sws.Range("A1:J1").Copy
dws.Range("A1").PasteSpecial xlPasteColumnWidths
dws.Select
dws.Range("A1").Select
Application.ScreenUpdating = True
End Sub

Open in new window

EE-Example.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
gregfthompsonAuthor Commented:
Thanks. Perfect!
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Thanks for the feedback!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.