copying blocks of data from one sheet to other sheets in same book

[jer]

Some assistance please - I am working with a spreadsheet that has been
imported from some other system, with skipped rows. I want to move similar
blocks of data from this spread sheet to another for example all where abbrev
begins with b2 to spreadsheet named "bregion" and for beginning tm to sheet
named tme
Region: 123456
Abbrev Name Invoice Date Amount
b2btr jon publ 01/15/2009 20.00
b2btr jon publ 03/02/2009 552.00
b2btr jon publ 03/02/2009 321.35
blank rows
blank rows
Region: 12356
Abbrev Name Invoice Date Amnt
tbmna jane done 12/22/2008 123.55
tbmna jane done 12/22/2008 99.89
blank rows
blank rows
Region: 3457
Abbrev Name Invoice Date Amnt
b2brr peter jones 03/02/2009 23.50
b2brr peter jones 03/03/2009 23.00
b2brr peter jones 03/03/2009 2.90

I have attempted the following but it copies the first block not not
subsequent blocks; acell is referene on original sheet trcell is cell
reference on sheets(regiony) where data is being copied to

do until acell = "End of Report"
If Left(acell, 7) = "Region:" And _
Left(acell.Offset(2, 0), 2) = "b2" Or _
acell.Offset(2, 0) = "b3" Then
Range(acell, acell.End(xlDown).Offset(0, 4)).Select
Selection.Copy
Sheets("regionY").Select
ActiveSheet.Paste
Application.CutCopyMode = False
trcell.End(xlDown).Offset(2, 0).Select
End If
Set acell = acell.Offset(1, 0)
Loop

 

[Per Jessen]

Hi

Assuming "End of Report" is in the first Cell after the data, try this:

Set aCell = Sheets("Sheet1").Range("A1")
Set trCell = Sheets("Region Y").Range("A1")
Do Until aCell.Offset(-2, 0).Value = "End of Report"
If Left(aCell, 7) = "Region:" And _
Left(aCell.Offset(2, 0), 2) = "b2" Or _
aCell.Offset(2, 0) = "b3" Then
Range(aCell, aCell.End(xlDown).Offset(0, 4)).Copy trCell
Set trCell = trCell.End(xlDown).Offset(2, 0)
End If
Set aCell = aCell.End(xlDown).Offset(3, 0)
Loop

Regards,
Per

 

[Gary''s Student]

Here is an approach that does not depend on the block structure. It just
moves down the original and copies "good" rows to the destination:

Sub movem()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim n As Long, i As Long, j As Long
Dim v As String

Set sh1 = Sheets("original")
Set sh2 = Sheets("regionY")
j = 1

sh1.Activate
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To n
If Left(Cells(i, 1).Value, 2) = "b2" Then
Rows(i).Copy sh2.Cells(j, 1)
j = j + 1
End If
Next
End Sub

 

[jer]

thanks Per for your response. The first block copied fine, however I am
getting a debug error for second block = "Select method of Range class
failed" not sure how to fix this, do you have any suggestions?
--
thanks as always for the help

Hi

Assuming "End of Report" is in the first Cell after the data, try this:

Set aCell = Sheets("Sheet1").Range("A1")
Set trCell = Sheets("Region Y").Range("A1")
Do Until aCell.Offset(-2, 0).Value = "End of Report"
If Left(aCell, 7) = "Region:" And _
Left(aCell.Offset(2, 0), 2) = "b2" Or _
aCell.Offset(2, 0) = "b3" Then
Range(aCell, aCell.End(xlDown).Offset(0, 4)).Copy trCell
Set trCell = trCell.End(xlDown).Offset(2, 0)
End If
Set aCell = aCell.End(xlDown).Offset(3, 0)
Loop

Regards,
Per

 

[jer]

thanks Gary's student for the response, however I need to main block
structure of copied data

 

[Per Jessen]

Hi

Try this, if it doesn't work remembet to tell which cell is highlighted when
you hit debug:

Set aCell = Sheets("Sheet1").Range("A1")
Set trCell = Sheets("Region Y").Range("A1")
Do
If Left(aCell, 7) = "Region:" And _
Left(aCell.Offset(2, 0), 2) = "b2" Or _
aCell.Offset(2, 0) = "b3" Then
Range(aCell, aCell.End(xlDown).Offset(0, 4)).Copy trCell
Set trCell = trCell.End(xlDown).Offset(2, 0)
End If
Set aCell = aCell.End(xlDown).Offset(3, 0)
Loop Until aCell.Offset(-3, 0).Value = "End of Report"
trCell.Offset(-2, 0).ClearContents

Regards,
Per

thanks Per for your response. The first block copied fine, however I am
getting a debug error for second block = "Select method of Range class
failed" not sure how to fix this, do you have any suggestions?

 

[jer]

Per, thank you very much. It works, however when all blocks of data are
copied I am getting a run time error 1004, being a newbie again I have to ask
any suggestions
--
thanks as always for the help
jer

Hi

Assuming "End of Report" is in the first Cell after the data, try this:

Set aCell = Sheets("Sheet1").Range("A1")
Set trCell = Sheets("Region Y").Range("A1")
Do Until aCell.Offset(-2, 0).Value = "End of Report"
If Left(aCell, 7) = "Region:" And _
Left(aCell.Offset(2, 0), 2) = "b2" Or _
aCell.Offset(2, 0) = "b3" Then
Range(aCell, aCell.End(xlDown).Offset(0, 4)).Copy trCell
Set trCell = trCell.End(xlDown).Offset(2, 0)
End If
Set aCell = aCell.End(xlDown).Offset(3, 0)
Loop

Regards,
Per

 

[Per Jessen]

Jen, we skip the "End of Report" approach to exit the loop and use this:

Set acell = Sheets("Sheet1").Range("A1")
Set trCell = Sheets("Region Y").Range("A1")
Do
If Left(acell, 7) = "Region:" And _
Left(acell.Offset(2, 0), 2) = "b2" Or _
acell.Offset(2, 0) = "b3" Then
Range(acell, acell.End(xlDown).Offset(0, 4)).Copy trCell
Set trCell = trCell.End(xlDown).Offset(2, 0)
End If
If IsEmpty(acell.End(xlDown).Offset(3, 0).Value) Then Exit Do
Set acell = acell.End(xlDown).Offset(3, 0)
Loop

BTW: When your macro is stoped by an error always click Debug, and tell
which line is highlighted when asking for help. Then we know whick line is
causing the problem.

---
Per

Per, thank you very much. It works, however when all blocks of data are
copied I am getting a run time error 1004, being a newbie again I have to
ask
any suggestions

 

[jer]

Per, works perfectly thank you very much for your time and talent and I note
your point about submitting error lines when asking for help

-- thanks as always for the help
jer