Paste entire rows to existing worksheets when column text criteria met

[xforum142riidax]

Hello All -

I have a subset of data I download twice a month into a master sheet. The data is comprised of the same 8 column headings, and anywhere from 200-400 rows. I'm looking for a resource to copy and paste certain rows to existing worksheets based on text identification in one of the columns.

CHECK IN	STATUS	GUEST'S NAME	NUMBER OF GUESTS	LISTING'S NICKNAME	TOTAL PAYOUT	TOTAL REFUNDED	SOURCE
1/18/2019	confirmed	Callum	4	10 Bonsall	397.7		AirBnB
1/25/2019	confirmed	Ben	6	10 Bonsall	382.18		AirBnB
1/29/2019	confirmed	Hannah	3	10 Bonsall	306.52		AirBnB
1/30/2019	confirmed	Brenda	5	7 Sycamore	411.28		AirBnB
1/12/2019	confirmed	MJ	5	11 Sycamore	249.29		AirBnB
1/13/2019	confirmed	Sulayman	4	11 Sycamore	191.09		AirBnB

<colgroup><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

Per the example above, data is downloaded into sheet tab "Master" ; the data should then be identified based on Column E "LISTING'S NICKNAME" and the entire row copied and pasted to the corresponding sheets in the next available blank row. Meaning: Any row with Column E containing "10 Bonsall" should have the entire row pasted to Sheet "10Bonsall" in the next available blank row ; Any row with Column E containing "7 Sycamore" should have the entire row pasted to Sheet "7Sycamore" in the next available blank row ; and so on. With a full data set there are a minimum of 70x different Listing Nicknames and corresponding Sheets.

Really need help and sincerely appreciate any advice. Thank you in advance!

 

[mumps]

Try:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long, Nickname As Range, RngList As Object, item As Variant
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each Nickname In Range("E2", Range("E" & Rows.Count).End(xlUp))
        If Not RngList.Exists(Nickname.Value) Then
            RngList.Add Nickname.Value, Nothing
        End If
    Next Nickname
    For Each item In RngList
        Range("A1:H" & LastRow).AutoFilter Field:=5, Criteria1:=item
        Range("A2:H" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets(item).Cells(Sheets(item).Rows.Count, "A").End(xlUp).Offset(1, 0)
        Range("A1").AutoFilter
    Next item
    Application.ScreenUpdating = True
End Sub

 

[xforum142riidax]

Mumps - thanks so much. However i'm way to much of a novice to know which variables i need to modify in order for the code to link the correct rows with the corresponding sheets. What does your example looks like for: Listing Nickname=10 Bonsall | Corresponding Sheet=10Bonsall . Again, thanks for your help!!

 

[mumps]

I'm not sure what you mean by: w

hich variables i need to modify in order for the code to link the correct rows with the corresponding sheets

Could you please explain in detail referring to specific cells, rows, columns and sheets? The Nickname in your data has a space between the number and the name while it appears that the sheet name does not. Does the sheet name also have a space between the number and the name?

 

[xforum142riidax]

Mumps - At the following link is an excel data set which can be viewed as an example: https://1drv.ms/x/s!At3D9JlAS7NcxUekhyJxgSE-zcQF . We add a new data set to sheet "Master Data" weekly starting in cell B2. I'm hoping to find a solution that will identify the data based on Column E "LISTING'S NICKNAME", which will then copy and paste entire rows to the corresponding "Tear Sheets", in the next available blank row in such sheets, starting with cell A2. Meaning: Any cell in Column E containing "10 Bonsall St" should have the entire row of data copied and pasted to Sheet "10 Bonsall Tear" in the next available blank row starting with cell b2 ; Any cell with Column E containing "7 Maple St" should have the entire row of data copied and pasted to Sheet "7 Maple Tear" in the next available blank row starting with cell B2; and so on. With a full data set there are a minimum of 70x different "Listing Nicknames" and corresponding "Tear Sheets".

Hope this helps.

 

[mumps]

Try:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long, Nickname As Range, RngList As Object, item As Variant, Val As String
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each Nickname In Range("E2", Range("E" & Rows.Count).End(xlUp))
        Val = Trim(Left(Nickname.Value, WorksheetFunction.Find("|", WorksheetFunction.Substitute(Nickname.Value, " ", "|", Len(Nickname.Value) - Len(WorksheetFunction.Substitute(Nickname.Value, " ", ""))))))
        If Not RngList.Exists(Val) Then
            RngList.Add Val, Nothing
        End If
    Next Nickname
    For Each item In RngList
        Range("A1:H" & LastRow).AutoFilter Field:=5, Criteria1:=item & "*"
        Range("A2:H" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets(item & " Tear").Cells(Sheets(item & " Tear").Rows.Count, "B").End(xlUp).Offset(1, 0)
        Range("A1").AutoFilter
    Next item
    Application.ScreenUpdating = True
End Sub