"Rich" wrote in message
...

"Wullie" wrote in message
...
I have a macro which does the same work as yours (on a smaller scale) and
it
works no problem (creating small files). Can you post your code so I can
see
how it compares to mine?




Here's the code:-

FERDCOPY()
'
' FERDCOPY Macro
' Macro recorded 02/09/2008 by Richard
'

'
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Columns("A:A").Select
Selection.EntireColumn.Hidden = True
Columns("E:E").ColumnWidth = 2
Columns("G:G").ColumnWidth = 2
Columns("I:I").ColumnWidth = 2
Columns("K:K").ColumnWidth = 2
Columns("M:M").ColumnWidth = 2
Columns("O:O").ColumnWidth = 2
Columns("Q:Q").ColumnWidth = 2
Columns("S:S").ColumnWidth = 2
Columns("U:AB").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
Application.CutCopyMode = False
With ActiveSheet.pagesetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.pagesetup.PrintArea = ""
With ActiveSheet.pagesetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub
Sub FERDSAVE()
'
' FERDSAVE Macro
' Macro recorded 02/09/2008 by Richard
'
' Keyboard Shortcut: Ctrl+n
'




ChDir "C:\Documents and Settings\Richard\Desktop\New Folder\FERD\SEP
FERD\FERD SF"
Dim WS As Worksheet
Set WS = ActiveSheet
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs WS.Range("B6") _
, FileFormat:=xlNormal, Password:="deleted",
WriteResPassword:="modify", _
ReadOnlyRecommended:=True, CreateBackup:=False
ActiveWindow.Close
End Sub

Sub FERDRUN()
'
' FERDRUN Macro
' Macro recorded 02/09/2008 by Richard
'
' Keyboard Shortcut: Ctrl+u
'
Range("A1").Select
Application.Run "PERSONAL.XLS!FERDCOPY"
Application.Run "PERSONAL.XLS!FERDSAVE"
End Sub



I then run this for branches 1 to 300 :-

Selection.AutoFilter Field:=2, Criteria1:="BRANCH1"
Application.Run "FERDRUN"

Selection.AutoFilter Field:=2, Criteria1:="BRANCH2"
Application.Run "FERDRUN"

Selection.AutoFilter Field:=2, Criteria1:="BRANCH3"
Application.Run "FERDRUN"

I could do with knowing a better way to do this, I'll ask this as a seperate
thread.
--
Rich
http://www.richdavies.com/excel.htm
http://www.richdavies.com/fantasy-football.htm


** Posted from http://www.teranews.com **