Generating new workbooks based on data
 

Hi Damien

Start here
http://www.rondebruin.nl/copy5.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"Damien McBain" wrote in message ...
Hi,

I'm trying to split a worksheet into many new workbooks, one for each
distinct value in column C (CostCentre) and copy the data in that row into
the new workbook. There are about 40 distinct cost centres and the list
contains around 12,000 records.

I want my code to cycle through all the "CostCentres" in column C and:
- if there's no workbook open with that name already, create one, and copy
the row into the new workbook then go to the next CostCentre
- if there is a workbook open with that name already, copy the row into the
workbook with the name of the cost centre then go to the next cost centre

What I have so far creates and names the first new workbook but it doesn't
copy the row and code execution halts.

Can someone please have a quick look and suggest where I'm going wrong?

========Code Begins===========
Sub FixPayrollSpreadsheet()
Dim WeekNo
Dim FilePath
Dim CCtr
Dim BookName

'WeekNo = InputBox("Enter Week Number", "Week Number")
FilePath = "C:\AGPayrollReports\" 'change this to change where files are
saved
ChDir FilePath

For Each c In Selection

CCtr = c.Value

On Error GoTo KeepGoing

'Set FileName = Workbooks(WeekNo & "-" & CCtr & ".xls")

Rows(c.Row).Copy Destination:=Workbooks(CStr(CCtr &
".xls")).Worksheets("Sheet1").Range("A65536").End( xlUp).Offset(1, 0)

GoTo KeepGoing1

KeepGoing:

CCtr = c.Value
BookName = CCtr & ".xls"

Workbooks.Add (FilePath & "PostingReport.xls")

Workbooks(Workbooks.Count).SaveAs FileName:=CStr(FilePath & BookName)

Rows(c.Row).Copy Destination:=Workbooks(CStr(CCtr &
".xls")).Worksheets("Sheet1").Range("A30000").End( xlUp).Offset(1, 0)

Set FileName = Nothing
Set CCtr = Nothing
Set BookName = Nothing

KeepGoing1:

Next c

End Sub
==============Code Ends============