Copying specific rows from one sheet to another

[Chris]

I have data on a sheet. I want to find all rows with
specific criteria (containing "variable data" from Site
sheet) and copy it to a new sheet with the name
of "variable information", continue until there are no
more variables on Site sheet.

The whole row must be copied. Some of the data rows will
have 10 columns others will have 20, for the sake of
space I will only list 4 columns below.


The site data sheet will have 1-75 sites listed. Only
three are listed below.

Sorting column C is fine.

sample data

worksheet "Site" (variable data)
A1 = chs
A2 = dub.aaa
A3 = lvl

worksheet "Data" (data to be parsed)
A1 = blank
B1 = NEW
C1 = test.chs.aaa.org
D1 = FRANK

A2 = blank
B2 = old
C2 = test.LVL.aaa.org
D2 = FRANK lvl

A3 = blank
B3 = NEW
C3 = test4_cccc.dub.aaa
D3 = FRANK DUB

A4 = blank
B4 = new
C4 = test.lvl.aaa.org
D4 = FRANK lvl 2

(on through 2000 rows)

Output

worksheet named "chs"
A1 = blank
B1 = NEW
C1 = test.chs.aaa.org
D1 = FRANK

worksheet named "lvl"
A1 = blank
B1 = old
C1 = test.lvl.aaa.org
D1 = FRANK lvl

A2 = blank
B2 = new
C2 = test.lvl.aaa.org
D2 = FRANK lvl 2

worksheet named "dub.aaa"
A1 = blank
B1 = NEW
C1 = test4_cccc.dub.aaa
D1 = FRANK DUB

All values will be listed in the 3rd column and will be
distinguished names (DN) as listed above. Some of the
DN may just be "aaa.org" or just "org" though. Not
necessarily only three letters either may be
xxxxxxxxxxxxxxxxxxxxx-xxxx.xxxxxxxxxxx.xxx.xxx

may or may not have "."

Thank you!

Chris

 

[steve]

Chris,

Try something like this (not tested).
This should work from any sheet since no selection is being
done and all references are sheet designated. And it should
run pretty fast.
You may have to add a 'Case else' to handle the odd-balls.

Dim lrow as Long, x as Long, y as Long, ws as String

' find last row in "Site" sheet
lrow= Sheets("Site").Cells(Rows.COUNT, "C").End(xlUp).Row

For x =1 to lrow
Select Case Sheets("Site").Cells(x,3)
Case "test.chs.aaa.org"
ws = "chs"
Case "test.lvl.aaa.org"
ws = "lvl"
Case "test4_cccc.dub.aaa"
ws = "dub"
End Select

If x = 1 then
y = 1
else
y = Sheets(ws).Cells(Rows.COUNT, "C").End(xlUp).Row +1
End If

Sheets("Site").Rows(x).Copy _
destination:= Sheets(ws).Cells(y, 1)
Next