D
Damien McBain
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============
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============