View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone[_2_] Jim Cone[_2_] is offline
external usenet poster
 
Posts: 1,549
Default Generating new workbooks based on data

Blocking and tackling comes first...
Declare all of your variables - use Option Explicit as the first line in the module.
With 12000 files don't use Variants unless you have to.
Don't use "FileName" as a variable - Excel already uses it.

It could be structured something like this...
'--
Dim WeekNo As Long
Dim FilePath As String
Dim CCtr As String
Dim wBook As Workbook
Dim c As Range
Dim strName As String

For Each c in Selection.Cells

'Piece the complete filepath together and then determine if it is valid...
If Len(Dir(filePath) 0 Then
Set wBook = ...
Open the workbook and add the data, save and close it.

Else 'If the path is not valid
Create the new workbook and add the data.
Save and close the new workbook.
End If

Next
--
Jim Cone
Portland, Oregon USA



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