Hi Andrew,
Works great for me. thanks a lot.
"AndrewCerritos" wrote:
> Here is my take:
> 1) each company has exactly 20 rows of data
> 2) company name is the first word in first cell
> 3) active sheet is the original data of companies
> 4) the company worksheets are created at the end in order they appeared
> 5) the first company starts at the first non-blank row
>
> Private Sub XfrCompPL()
> Dim rngC1 As Range ' the range for Company
> Dim nCol As Long ' number of columns
> Dim strCName As String ' company name
> Dim wsC1 As Worksheet ' target new worksheet name
>
> nCol = ActiveSheet.UsedRange.Columns.Count
> Set rngC1 = ActiveSheet.UsedRange.Range("A1") ' first cell
> Do While rngC1.Value <> ""
> strCName = Split(rngC1.Value, " ")(0) ' first word is company
> name
> Set rngC1 = rngC1.Resize(20, nCol) ' range is the company's
> cells
> Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count)) '
> last tab
> wsC1.Name = strCName ' name the sheet
> rngC1.Copy Destination:=wsC1.[A1] ' copy to it
> Set rngC1 = rngC1.Range("A1").Offset(20) ' next company
> Loop
> End Sub
>
> --AC
>
> "Mike H" wrote:
>
> > Hi,
> >
> > I just replicated that error on this like
> >
> > ShName = Left(c.Value, InStr(c.Value, " ") - 1)
> >
> > But the problem is on these 2 lines
> >
> > lastrow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
> > Set myrange = Sheets("Sheet1").Range("A1:A" & lastrow)
> >
> > Change "Sheet1" on both these lines to the actual sheet name that contains
> > your original data. Note the sheet name must be in quotes.
> >
> > In addition change "A" in both these lines to the first column of you P&L
> > data, like wise the column leter must be in quotes.
> >
> > Mike
> >
> > "sutha" wrote:
> >
> > > Hi Mike,
> > > Thanks for your quick reply.i am geting an error message" invalid proceedure
> > > call or argument'.
> > > Sutha
> > >
> > > "Mike H" wrote:
> > >
> > > > Hi,
> > > >
> > > > You didn't say where you want the data pasting so this pastes ot ti row 1 in
> > > > the addded sheet. Alt+F11 to open VB editor. Right click 'This workbook' and
> > > > insert module and paste this code in and run it. It assumes your P&L data are
> > > > on sheet 1
> > > >
> > > > Sub Liminal()
> > > > lastrow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
> > > > Set myrange = Sheets("Sheet1").Range("A1:A" & lastrow)
> > > > For Each c In myrange
> > > > ShName = Left(c.Value, InStr(c.Value, " ") - 1)
> > > > Set c = c.Resize(, 20)
> > > > c.Copy
> > > > Worksheets.Add After:=ActiveSheet
> > > > ActiveSheet.Name = ShName
> > > > Range("A1").PasteSpecial
> > > > Next
> > > > End Sub
> > > >
> > > > Mike
> > > >
> > > > "sutha" wrote:
> > > >
> > > > > I HAVE A SHEET WITH P&L FOR 100 COMPANIES ONE BELOW ANOTHER. EACH P&L IS SAME
> > > > > IN SIZE( 20 RAWS)
> > > > >
> > > > > Can someone please help with a sub that will copy each p&l in different
> > > > > sheet and name each sheet with the 1st word found in the begining of the
> > > > > range (Eg; raw 1
> > > > > company name "xxx")
|
Similar Threads
