Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create Multiple Worksheets from One
I have a worksheet that contains about 3000 rows. I would like to cut data
from this worksheet and copy all data whenever the value in column C changes. For example, for this worksheet: A B C 163 4/4/2005 51 168 4/2/2005 51 123 4/5/2005 62 128 4/1/2005 62 187 4/9/2005 71 I need to create three new worksheets, the first containing rows 1 and 2, the second containing rows 3 and 4, and the third containing row 5. I'm not sure of the best way to go about this. Any suggestions welcome. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create Multiple Worksheets from One
See
http://www.rondebruin.nl/copy5.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Kdub via OfficeKB.com" wrote in message ... I have a worksheet that contains about 3000 rows. I would like to cut data from this worksheet and copy all data whenever the value in column C changes. For example, for this worksheet: A B C 163 4/4/2005 51 168 4/2/2005 51 123 4/5/2005 62 128 4/1/2005 62 187 4/9/2005 71 I need to create three new worksheets, the first containing rows 1 and 2, the second containing rows 3 and 4, and the third containing row 5. I'm not sure of the best way to go about this. Any suggestions welcome. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create Multiple Worksheets from One
(untested code)
You could loop each row and copy each: ========================================== Dim lrw1 as long, lrw2 as long, rw1 as long lrw1 = ActiveSheet.Cells(Rows.COUNT, "A").Row lrw2 = Sheets(ActiveSheet.Cells(1,3).Text).Cells(Rows.COU NT, "A").Row ' or however you identify your sheet to paste to Activesheet.Rows(1).Copy _ Destination:=Sheets(ActiveSheet.Cells(1,3).Text).C ells(1,lrw2) For rw1 = 2 to lrw1 lrw2 = Sheets(ActiveSheet.Cells(rw1,1).Text) ' or however you identify your sheet to paste to Activesheet.Rows(rw1).Copy _ Destination:=Sheets(ActiveSheet.Cells(rw1,3).Text) .Cells(1,lrw2) Next ============================================= You might also try: Sheets("paste to sheet").Rows(lrw2)=Sheets("master sheet").Rows(lrw1) The trick is transforming column C into a sheet reference. Don't know how long this will take. You could get creative and define blocks of rows to paste... -- steveB Remove "AYN" from email to respond "Kdub via OfficeKB.com" wrote in message ... I have a worksheet that contains about 3000 rows. I would like to cut data from this worksheet and copy all data whenever the value in column C changes. For example, for this worksheet: A B C 163 4/4/2005 51 168 4/2/2005 51 123 4/5/2005 62 128 4/1/2005 62 187 4/9/2005 71 I need to create three new worksheets, the first containing rows 1 and 2, the second containing rows 3 and 4, and the third containing row 5. I'm not sure of the best way to go about this. Any suggestions welcome. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create Multiple Worksheets from One
Here's what I ended up doing. Works great.
This creates multiple sheets from one master, loops through to perform edits on every sheet, then combines all the data back into the master, deleting the intermediate worksheets. Takes about 4 sec. for 5000 rows Dim LastRow, LastCol, MasterLastRow As Long Dim WBName As String Dim ReplaceValue, NewName, DMName As String Dim CopyRange, r, rng, MasterRange As Range Dim SheetArray(), SheetCount, I, P, MyLoc As Integer Dim First As Boolean Application.ScreenUpdating = False First = True MyLoc = InStr(1, ActiveWorkbook.Name, ".") WBName = Left(ActiveWorkbook.Name, MyLoc - 1) SheetCount = 0 ActiveSheet.Name = "MyMaster" CurrentStore = Range("C1").Value LastRow = (Cells(Rows.Count, 3).End(xlUp).Row) LastCol = Cells(2, Columns.Count).End(xlToLeft).Column Range("C1").Activate Do While CurrentStore < "" If ActiveCell.Value < CurrentStore Then CopyRange = Range(Cells(1, 1), Cells(ActiveCell.Row - 1, LastCol)) ..Address Range(CopyRange).Select Selection.Copy SheetName = WBName & "-" & CurrentStore Worksheets.Add SheetCount = SheetCount + 1 ActiveSheet.Name = SheetName ActiveSheet.Paste Rows(1).Insert Range("A1").Value = CurrentStore Sheets("MyMaster").Activate Selection.Delete xlUp Range("C1").Activate CurrentStore = ActiveCell.Value End If ActiveCell.Offset(1, 0).Activate Loop For I = 1 To Sheets.Count If Sheets(I).Name = "MyMaster" Then GoTo MyNext End If Sheets(I).Activate Columns(5).Delete Columns(4).Delete Columns(3).Delete Columns(2).Delete CurrentStore = Range("A1").Value Rows(1).Delete Call InsertFirstColandFormat Call ModifyUOM Call InsertHeaderAndFooter MyNext: Next I For P = 1 To Sheets.Count If Sheets(P).Name = "MyMaster" Then GoTo PasteNext End If Sheets(P).Activate LastRow = (Cells(Rows.Count, 3).End(xlUp).Row) LastCol = Cells(2, Columns.Count).End(xlToLeft).Column 'Paste all sheets back into master CopyRange = Range(Cells(1, 1), Cells(LastRow, LastCol)).Address Range(CopyRange).Select Selection.Copy Sheets("MyMaster").Activate If First = True Then First = False Range("A1").Select Else MasterLastRow = ActiveSheet.Cells.Find(What:="*", _ SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows).Row + 1 Range(Cells(MasterLastRow, 1), Cells(MasterLastRow, 1)).Cells.Select 'Range(MasterRange).Select End If ActiveSheet.Paste PasteNext: Next P 'Delete Extra worksheets Application.DisplayAlerts = False Do While Sheets.Count 1 If Sheets(1).Name < "MyMaster" Then Sheets(1).Activate Sheets(1).Delete End If Loop Application.ScreenUpdating = True End Sub -- Message posted via http://www.officekb.com |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Create multiple worksheets from list | Excel Discussion (Misc queries) | |||
Create Multiple Worksheets based on Market | Excel Discussion (Misc queries) | |||
How do I create an overall graph from Multiple worksheets? | Excel Worksheet Functions | |||
create & name multiple worksheets | Excel Worksheet Functions | |||
How to I create a macro in Excell to add multiple worksheets? | Excel Programming |