find and paste Blocks

[Taru]

I need to find a specific ID in a database, then paste all of the stuff
below it into a new document. Now all of the Stuff that I want to copy
starts with GO: and I want it to copy every row below the ID, until it
runs into >TC. >TC is the beginning of the next ID.

How do I go about making something start copying right below something
it finds for an unkown number or rows, and then stop when it sees a
specific word?

 

[somethinglikeant]

Assuming you are running down column A. Change start cell if any
different.

Sub IDCopy()
[A1].Select
Do Until ActiveCell.Value = "GO"
ActiveCell.Offset(1, 0).Select
Loop
startrow = ActiveCell.Row
Do Until ActiveCell.Value = "TC"
ActiveCell.Offset(1, 0).Select
Loop
endrow = ActiveCell.Row - 1
Rows(startrow & ":" & endrow).Select

Selection.Copy
Workbooks.Add
ActiveSheet.Paste: Application.CutCopyMode = False
[A1].Select
End Sub

somethinglikeant

 

[Guest]

Dim cell as Range, id as Variant
Dim rStart as Range, rEnd as Range
for each cell in selection
if cell = ID then
set rStart = cell.offset(1,0)
end if
if not rStart is nothing then
if cell.Value = "TC" then
set rEnd = cell.offset(-1,0)
exit for
end if
end if
Next
set rng = Range(rStart,rEnd)
rng.EntireRow.copy Destination:=Worksheets("Other").Range("A1")

' now you can loop through the results and delete anything that doesn't
start with GO

 

[Taru]

Sorry guys but neither of those worked. Somethinglikeant your's just
ran through my document and didn't do anything. And I don't know
enough about VBA to tweek it.

Tom, you've helped me out before and I'm really glad you replied. But
Your's also didn't work either. I just slapped it between a sub () and
an end sub. But again, I don't know enough VBA to edit it. I've
attached a small excel file with samples of what I'm working with.

In sheet1 You'll find the TC ID, which is what I'm searching Sheet2
for. When I find it in Sheet2 I copy and paste everything under the TC
ID until the next TC ID below it. And all the information begins with
GO:

Please help me out guys.


+-------------------------------------------------------------------+
|Filename: Help Book.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4908 |
+-------------------------------------------------------------------+

 

[Tom Ogilvy]

Sub Tester1()
Dim cell As Range, id As String
Dim rStart As Range, rEnd As Range
Dim sh As Worksheet, rng As Range
id = ">TC38169"

Set rng = Range(Cells(1, 1), _
Cells(Rows.Count, 1).End(xlUp))
If Application.CountIf(rng, "*TC*") = 0 Then
MsgBox "Wrong Sheet Active"
Exit Sub
End If
For Each cell In rng
If Not rStart Is Nothing Then
If Left(cell.Value, 3) = ">TC" Then
Set rEnd = cell.Offset(-1, 0)
Exit For
End If
End If
If cell = id Then
Set rStart = cell.Offset(1, 0)
End If
Next
Set rng = Range(rStart, rEnd)
With ThisWorkbook
Worksheets.Add After:=.Sheets(Sheets.Count)
End With
Set sh = ActiveSheet
rng.EntireRow.Copy Destination:=sh.Range("A1")


End Sub

worked for me with your test file.