Paste entire rows to existing worksheets when column text criteria met

xforum142riidax

New Member
Joined
Feb 16, 2019
Messages
3
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.
[TABLE="width: 786"]
<colgroup><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]CHECK IN[/TD]
[TD]STATUS[/TD]
[TD]GUEST'S NAME[/TD]
[TD]NUMBER OF GUESTS[/TD]
[TD]LISTING'S NICKNAME[/TD]
[TD]TOTAL PAYOUT[/TD]
[TD]TOTAL REFUNDED[/TD]
[TD]SOURCE[/TD]
[/TR]
[TR]
[TD="align: right"]1/18/2019[/TD]
[TD]confirmed[/TD]
[TD]Callum [/TD]
[TD="align: right"]4[/TD]
[TD]10 Bonsall[/TD]
[TD="align: right"]397.7[/TD]
[TD][/TD]
[TD]AirBnB[/TD]
[/TR]
[TR]
[TD="align: right"]1/25/2019[/TD]
[TD]confirmed[/TD]
[TD]Ben [/TD]
[TD="align: right"]6[/TD]
[TD]10 Bonsall[/TD]
[TD="align: right"]382.18[/TD]
[TD][/TD]
[TD]AirBnB[/TD]
[/TR]
[TR]
[TD="align: right"]1/29/2019[/TD]
[TD]confirmed[/TD]
[TD]Hannah [/TD]
[TD="align: right"]3[/TD]
[TD]10 Bonsall[/TD]
[TD="align: right"]306.52[/TD]
[TD][/TD]
[TD]AirBnB[/TD]
[/TR]
[TR]
[TD="align: right"]1/30/2019[/TD]
[TD]confirmed[/TD]
[TD]Brenda [/TD]
[TD="align: right"]5[/TD]
[TD]7 Sycamore[/TD]
[TD="align: right"]411.28[/TD]
[TD][/TD]
[TD]AirBnB[/TD]
[/TR]
[TR]
[TD="align: right"]1/12/2019[/TD]
[TD]confirmed[/TD]
[TD]MJ [/TD]
[TD="align: right"]5[/TD]
[TD]11 Sycamore[/TD]
[TD="align: right"]249.29[/TD]
[TD][/TD]
[TD]AirBnB[/TD]
[/TR]
[TR]
[TD="align: right"]1/13/2019[/TD]
[TD]confirmed[/TD]
[TD]Sulayman [/TD]
[TD="align: right"]4[/TD]
[TD]11 Sycamore[/TD]
[TD="align: right"]191.09[/TD]
[TD][/TD]
[TD]AirBnB[/TD]
[/TR]
</tbody>[/TABLE]

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!
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Try:
Code:
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
 
Upvote 0
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!!
 
Upvote 0
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?
 
Upvote 0
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.

 
Upvote 0
Try:
Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top