Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" skrev i meddelelsen ... 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 |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" skrev i meddelelsen ... 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 |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" skrev i meddelelsen ... 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" skrev i meddelelsen ... 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 |
#7
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" skrev i meddelelsen ... 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 |
#8
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" skrev i meddelelsen ... 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" skrev i meddelelsen ... 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 |
#9
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" skrev i meddelelsen ... 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" skrev i meddelelsen ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Copying data from several sheets to a front sheet | Excel Worksheet Functions | |||
Copying Data from Multiple Sheets to One sheet | Excel Worksheet Functions | |||
Copying sheets into a new work book | Excel Programming | |||
Copying data from multiple sheets into one sheet | Excel Programming | |||
macro stops copying sheets into a book after the 11th sheet | Excel Programming |