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
--
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

"jer" <(E-Mail Removed)> skrev i meddelelsen
news:4B1A1852-2AD3-4279-8F6F-(E-Mail Removed)...
> 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
> --
> thanks as always for the help
> jer

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

--
Gary''s Student - gsnu200839


"jer" wrote:

> 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
> --
> thanks as always for the help
> 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


"Per Jessen" wrote:

> 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" <(E-Mail Removed)> skrev i meddelelsen
> news:4B1A1852-2AD3-4279-8F6F-(E-Mail Removed)...
> > 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
> > --
> > thanks as always for the help
> > jer
>
>

thanks Gary's student for the response, however I need to main block
structure of copied data
--
thanks as always for the help
jer


"Gary''s Student" wrote:

> 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
>
> --
> Gary''s Student - gsnu200839
>
>
> "jer" wrote:
>
> > 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
> > --
> > thanks as always for the help
> > jer

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
"jer" <(E-Mail Removed)> skrev i meddelelsen
newsA80CB94-FF1F-44E0-A94F-(E-Mail Removed)...
> 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
>
>
> "Per Jessen" wrote:
>
>> 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" <(E-Mail Removed)> skrev i meddelelsen
>> news:4B1A1852-2AD3-4279-8F6F-(E-Mail Removed)...
>> > 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
>> > --
>> > thanks as always for the help
>> > 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

"Per Jessen" wrote:

> 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" <(E-Mail Removed)> skrev i meddelelsen
> news:4B1A1852-2AD3-4279-8F6F-(E-Mail Removed)...
> > 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
> > --
> > thanks as always for the help
> > jer
>
>

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

"jer" <(E-Mail Removed)> skrev i meddelelsen
news:FA2EBD4D-EB07-42C0-8055-(E-Mail Removed)...
> 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
>
> "Per Jessen" wrote:
>
>> 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" <(E-Mail Removed)> skrev i meddelelsen
>> news:4B1A1852-2AD3-4279-8F6F-(E-Mail Removed)...
>> > 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
>> > --
>> > thanks as always for the help
>> > 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

"Per Jessen" wrote:

> 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
>
> "jer" <(E-Mail Removed)> skrev i meddelelsen
> news:FA2EBD4D-EB07-42C0-8055-(E-Mail Removed)...
> > 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
> >
> > "Per Jessen" wrote:
> >
> >> 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" <(E-Mail Removed)> skrev i meddelelsen
> >> news:4B1A1852-2AD3-4279-8F6F-(E-Mail Removed)...
> >> > 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
> >> > --
> >> > thanks as always for the help
> >> > jer
> >>
> >>
>
>