copy data of different range to other sheets

[sutha]

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

 

[Mike H]

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]

Hi Mike,
Thanks for your quick reply.i am geting an error message" invalid proceedure
call or argument'.
Sutha

 

[Mike H]

Hi Mike,
Thanks for your quick reply.i am geting an error message" invalid proceedure
call or argument'.
Sutha

 

[Mike H]

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]

Hi ,
When I run the message popped up. there is no line number. Please bear with
me. I am new to VBa. Thanks

 

[AndrewCerritos]

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

 

[sutha]

Hi Andrew,
Works great for me. thanks a lot.

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

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