Hi all

I'm a bit of a newbie so go easy on me. I need a macro to copy dat
from a wroksheet and paste it into a new worksheet, with name of th
worksheet that a specific name from a cell. I.e. I have a sheet wit
numerous rows, in whcih the column B contains names. I need the macr
to copy and paste all the rows with identical names into a ne
worksheet, with name of the worksheet as the name of that particula
cell. I have about 3000 rows, with about 100 different names in it, s
you can understand why it would be useful to split this data.
Any help would be much apreciated.

Thanks

O

--
Message posted from http://www.ExcelForum.com

Hi Oz,

The Following Code would be helpful (I did not try it, but it must
work) :
Private stNames(150) as String, intIdx as Integer

Public Sub mainPRG()
Application.Screenupdating = False
getNames()
createSheets()
insertData()
Application.Screenupdating = True
End Sub

Private Sub getNames()
Dim intRow as Integer, wsMain as Worksheet
Dim strReadName as String

set wsMain = ActiveWorkbook.Worksheets("Name of worksheet, which
contains data")
intIdx = 1
intRow = 1 'if you have Columntitles this should be start at 2
With wsMain
Do
strReadName = .Cells(intRow,2)
if checkNewName(strReadName) then
strNames(intIdx) = strReadName
intIdx = intIdx + 1
end if
intRow=intRow+1
Loop while .Cells(intRow,2)<""
End With

End Sub

Private Function checkNewName(pstrReadName as Strng) as Boolean
Dim i as Integer, bResult as Boolean

bResult = True

For i = 1 to intIdx
if strNames(i) = pstrReadName then
bResult=False
Exit For
end if
Next
checkNewName = bResult
End Function

Private Sub createSheets()

Dim i as Integer, wsNew as Worksheet

For i = 1 to intIdx
set wsNew = ActiveWorkbook.Worksheets.Add
wsNew.Name = strNames(i)
Next

End Sub

Private Sub insertData()

Dim i as Integer, intRow as Integer, wsMain as Worksheet
Dim strName as String

set wsMain = ActiveWorksheet

intRow = 1 'if you have Columntitles this should be start at 2
With wsMain
Do
strName = .Cells(intRow,2)
..Rows(intRow).Select
Selection.Copy
ActiveWorkbook.Sheets(strName).Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
intRow = intRow + 1
Loop until .Cells(intRow,2)=""
End With
End Sub


---
Message posted from http://www.ExcelForum.com/

Hi tolgag

Thanks for the help, it's getting there. i do get an error saying
"Method 'Name' of object '_Worksheet' failed" when run the macro. It
does create new sheets according to the values in the column but runs
into this error before pasting the data. When debugging the rror, it
points to the line with
"wsNew.Name = strNames(i)" and I'm not sure what this means.
Any ideas?

Thanks


---
Message posted from http://www.ExcelForum.com/

Hi,

Actually there are no error handling and logical controls in the macro.
You have to add them by yourself, 'cause I don't know, how the data
look like.

The error caued probably by a row, which doesn't contain a valid name.
The name in this row could be null or contains some illegal character,
which are not allowed as a sheetname. There may be a need of some
functions to remove them.


---
Message posted from http://www.ExcelForum.com/

Hi

Thanks, I have added in an If statement to end the worksheet creatio
Sub if cell is empty. Seems to have worked, but I do get another erro
when copying the relevant rows. When I run, it comes up with an erro
saying "Selct method of Range class failed", referring t
".Rows(intRow).Select"

Any ideas?

Thanks

O

--
Message posted from http://www.ExcelForum.com

Hi,
This error points, that you don't have any object (in this cas
worksheet). Check, if the "End With" statement comes before this lin
of code. If yes, then move it to the end

--
Message posted from http://www.ExcelForum.com

Hello,

The "End With" statement comes at the end of the Sub

Here's the code for it

Private Sub insertData()

Dim i As Integer, intRow As Integer, wsMain As Worksheet
Dim strName As String

Set wsMain = ActiveWorkbook.Worksheets("errorlist")

intRow = 2
With wsMain
Do
strName = .Cells(intRow, 2)
.Rows(intRow).Select
Selection.Copy
ActiveWorkbook.Sheets(strName).Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
intRow = intRow + 1
Loop Until .Cells(intRow, 2) = ""
End With
End Sub


So I'm at a loss as to why it doesn't except the range.

:

--
Message posted from http://www.ExcelForum.com

Hi,

If you look carefully, you'll see that you forgot to activate th
sheet. You can only select a range on the active sheet.

.Activate must be added before selec

--
Message posted from http://www.ExcelForum.com

or don't select anything

Private Sub insertData()
Dim i As Integer, intRow As Integer, wsMain As Worksheet
Dim strName As String

Set wsMain = ActiveWorkbook.Worksheets("errorlist")

intRow = 2
With wsMain
Do
strName = .Cells(intRow, 2)
Rows(intRow).Copy
ActiveWorkbook.Sheets(strName).Cells(intRow-1,1).Paste
intRow = intRow + 1
Loop Until .Cells(intRow, 2) = ""
End With
End Sub

untested.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"tolgag " wrote in message
...
Hi,

If you look carefully, you'll see that you forgot to activate the
sheet. You can only select a range on the active sheet.

Activate must be added before select


---
Message posted from http://www.ExcelForum.com/

Thanks guys, works a peach. Ever greatful...

Cheer

--
Message posted from http://www.ExcelForum.com

Any ideas as to how can modify this to paste the first row of the main
sheet (errorlist) to every subsequent worksheet created, as well as the
other copied rows, as it contains the right headers?

It would help a lot

Thanks


---
Message posted from http://www.ExcelForum.com/

Hi,

You can try to do the same thing in the "NewSheet" Event of th
workbook

--
Message posted from http://www.ExcelForum.com