Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
creating new workbook from single worksheet
Hi,
I have a worksheet with multiple reports in it. Each report has report name, description and columns, I've copied a sample below. How can create a new workbook for each report. Summary of Advertisers, Revenue and QCEs South Hampton Roads Market Source: STARS / ICVP, 12/10/2003 (Tompkins) MARKET MARKET_NAME REV01 REV02 REV03 REVGAIN02 76618 SOUTH HAMPTON RDS 2,362,440 2,387,894 3,167,806 1.1% 76642 PENINSULA 1,632,760 1,711,185 1,268,229 4.8% 76842 SUFFOLK 310,437 295,856 4,906 -4.7% 4,305,637 4,394,934 4,440,942 2.1% Summary of Advertiser Activity South Hampton Roads Market Source: STARS / ICVP, 12/10/2003 (Tompkins) PUB_YR MARKET MARKET_NAME STARTING_REVENUE ENDING_REVENUE START_ADVERTS 2000 76618 SOUTH HAMPTON RDS 2,151,773 2,295,891 7,073 2000 76642 PENINSULA 1,563,321 1,620,962 3,790 2000 76842 SUFFOLK 294,974 313,986 415 4,010,068 4,230,839 11,278 Thanks! Shaun |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
creating new workbook from single worksheet
do a loop that finds each occurance of the word 'summary'
the first occurance is the row of the "header", and the line above the next is th e"footer", if there's no next then the "footer" row wll be the last row +2 now you know the first and last row of the data, just copy then to a new sheet. here's a few lines of code that worked ok with your snippet:- Sub Extract() Dim sFind As String Dim ThisWS As Worksheet Dim NewWS As Worksheet Dim StartCell As Range Dim NextCell As Range Dim firstAdd As String Dim firstrow As Long Dim lastrow As Long sFind = "Summary" Set ThisWS = ActiveSheet Set StartCell = ThisWS.Cells.Find(sFind) If Not StartCell Is Nothing Then firstAdd = StartCell.Address Do firstrow = StartCell.Row Set NextCell = ThisWS.Cells.FindNext (StartCell) If NextCell Is Nothing Or NextCell.Address = firstAdd Then lastrow = ThisWS.Range("A65000").End (xlUp).Row + 2 Else lastrow = NextCell.Row - 1 End If Set NewWS = Worksheets.Add ThisWS.Range(firstrow & ":" & lastrow).Copy NewWS.Range("A1").PasteSpecial xlPasteAll Set StartCell = NextCell Loop Until StartCell.Address = firstAdd Or StartCell Is Nothing End If End Sub Patrick Molloy Microsoft Excel MVP -----Original Message----- Hi, I have a worksheet with multiple reports in it. Each report has report name, description and columns, I've copied a sample below. How can create a new workbook for each report. Summary of Advertisers, Revenue and QCEs South Hampton Roads Market Source: STARS / ICVP, 12/10/2003 (Tompkins) MARKET MARKET_NAME REV01 REV02 REV03 REVGAIN02 76618 SOUTH HAMPTON RDS 2,362,440 2,387,894 3,167,806 1.1% 76642 PENINSULA 1,632,760 1,711,185 1,268,229 4.8% 76842 SUFFOLK 310,437 295,856 4,906 - 4.7% 4,305,637 4,394,934 4,440,942 2.1% Summary of Advertiser Activity South Hampton Roads Market Source: STARS / ICVP, 12/10/2003 (Tompkins) PUB_YR MARKET MARKET_NAME STARTING_REVENUE ENDING_REVENUE START_ADVERTS 2000 76618 SOUTH HAMPTON RDS 2,151,773 2,295,891 7,073 2000 76642 PENINSULA 1,563,321 1,620,962 3,790 2000 76842 SUFFOLK 294,974 313,986 415 4,010,068 4,230,839 11,278 Thanks! Shaun . |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
creating new workbook from single worksheet
Thanks Patrick, the code you provided was awesome and it does amlost exactly what I need it to do. The only problem is it doesn't pick up the first and last reports. I received a 'Method Range of object worksheet failed error'. I did get a new sheet for 6 of the 8 reports on the spreadsheet. Shaun ----- Patrick Molloy wrote: ----- do a loop that finds each occurance of the word 'summary' the first occurance is the row of the "header", and the line above the next is th e"footer", if there's no next then the "footer" row wll be the last row +2 now you know the first and last row of the data, just copy then to a new sheet. here's a few lines of code that worked ok with your snippet:- Sub Extract() Dim sFind As String Dim ThisWS As Worksheet Dim NewWS As Worksheet Dim StartCell As Range Dim NextCell As Range Dim firstAdd As String Dim firstrow As Long Dim lastrow As Long sFind = "Summary" Set ThisWS = ActiveSheet Set StartCell = ThisWS.Cells.Find(sFind) If Not StartCell Is Nothing Then firstAdd = StartCell.Address Do firstrow = StartCell.Row Set NextCell = ThisWS.Cells.FindNext (StartCell) If NextCell Is Nothing Or NextCell.Address = firstAdd Then lastrow = ThisWS.Range("A65000").End (xlUp).Row + 2 Else lastrow = NextCell.Row - 1 End If Set NewWS = Worksheets.Add ThisWS.Range(firstrow & ":" & lastrow).Copy NewWS.Range("A1").PasteSpecial xlPasteAll Set StartCell = NextCell Loop Until StartCell.Address = firstAdd Or StartCell Is Nothing End If End Sub Patrick Molloy Microsoft Excel MVP -----Original Message----- Hi, I have a worksheet with multiple reports in it. Each report has report name, description and columns, I've copied a sample below. How can create a new workbook for each report. Summary of Advertisers, Revenue and QCEs South Hampton Roads Market Source: STARS / ICVP, 12/10/2003 (Tompkins) MARKET MARKET_NAME REV01 REV02 REV03 REVGAIN02 76618 SOUTH HAMPTON RDS 2,362,440 2,387,894 3,167,806 1.1% 76642 PENINSULA 1,632,760 1,711,185 1,268,229 4.8% 76842 SUFFOLK 310,437 295,856 4,906 - 4.7% 4,305,637 4,394,934 4,440,942 2.1% Summary of Advertiser Activity South Hampton Roads Market Source: STARS / ICVP, 12/10/2003 (Tompkins) PUB_YR MARKET MARKET_NAME STARTING_REVENUE ENDING_REVENUE START_ADVERTS 2000 76618 SOUTH HAMPTON RDS 2,151,773 2,295,891 7,073 2000 76642 PENINSULA 1,563,321 1,620,962 3,790 2000 76842 SUFFOLK 294,974 313,986 415 4,010,068 4,230,839 11,278 Thanks! Shaun . |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
creating new workbook from single worksheet
There's a slight problem if your data starts in A1 (or row 1, I bet).
Try changing this line: Set StartCell = ThisWS.Cells.Find(sFind) to: With ThisWS Set StartCell = .Cells.Find(sFind, after:=.Cells(.Cells.Count)) End With Then you'll be working from the top, down. (In fact, I'd specify almost every option in the .find: With ThisWS Set StartCell = .Cells.Find(what:=sFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ lookat:=xlPart, _ searchdirection:=xlNext, _ searchorder:=xlByRows, _ MatchCase:=False) End With ..find is one of those things that remembers the last .find's parms--even if the user did it manually. Shaun wrote: Thanks Patrick, the code you provided was awesome and it does amlost exactly what I need it to do. The only problem is it doesn't pick up the first and last reports. I received a 'Method Range of object worksheet failed error'. I did get a new sheet for 6 of the 8 reports on the spreadsheet. Shaun ----- Patrick Molloy wrote: ----- do a loop that finds each occurance of the word 'summary' the first occurance is the row of the "header", and the line above the next is th e"footer", if there's no next then the "footer" row wll be the last row +2 now you know the first and last row of the data, just copy then to a new sheet. here's a few lines of code that worked ok with your snippet:- Sub Extract() Dim sFind As String Dim ThisWS As Worksheet Dim NewWS As Worksheet Dim StartCell As Range Dim NextCell As Range Dim firstAdd As String Dim firstrow As Long Dim lastrow As Long sFind = "Summary" Set ThisWS = ActiveSheet Set StartCell = ThisWS.Cells.Find(sFind) If Not StartCell Is Nothing Then firstAdd = StartCell.Address Do firstrow = StartCell.Row Set NextCell = ThisWS.Cells.FindNext (StartCell) If NextCell Is Nothing Or NextCell.Address = firstAdd Then lastrow = ThisWS.Range("A65000").End (xlUp).Row + 2 Else lastrow = NextCell.Row - 1 End If Set NewWS = Worksheets.Add ThisWS.Range(firstrow & ":" & lastrow).Copy NewWS.Range("A1").PasteSpecial xlPasteAll Set StartCell = NextCell Loop Until StartCell.Address = firstAdd Or StartCell Is Nothing End If End Sub Patrick Molloy Microsoft Excel MVP -----Original Message----- Hi, I have a worksheet with multiple reports in it. Each report has report name, description and columns, I've copied a sample below. How can create a new workbook for each report. Summary of Advertisers, Revenue and QCEs South Hampton Roads Market Source: STARS / ICVP, 12/10/2003 (Tompkins) MARKET MARKET_NAME REV01 REV02 REV03 REVGAIN02 76618 SOUTH HAMPTON RDS 2,362,440 2,387,894 3,167,806 1.1% 76642 PENINSULA 1,632,760 1,711,185 1,268,229 4.8% 76842 SUFFOLK 310,437 295,856 4,906 - 4.7% 4,305,637 4,394,934 4,440,942 2.1% Summary of Advertiser Activity South Hampton Roads Market Source: STARS / ICVP, 12/10/2003 (Tompkins) PUB_YR MARKET MARKET_NAME STARTING_REVENUE ENDING_REVENUE START_ADVERTS 2000 76618 SOUTH HAMPTON RDS 2,151,773 2,295,891 7,073 2000 76642 PENINSULA 1,563,321 1,620,962 3,790 2000 76842 SUFFOLK 294,974 313,986 415 4,010,068 4,230,839 11,278 Thanks! Shaun . -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sending a single worksheet from a workbook | Excel Discussion (Misc queries) | |||
how do i hide a single worksheet in a workbook? | Excel Discussion (Misc queries) | |||
merging single worksheet files into a single workbook | Excel Discussion (Misc queries) | |||
Creating a single workbook from multiple workbooks | Excel Discussion (Misc queries) | |||
emailing a single worksheet from a workbook | Excel Worksheet Functions |