Originally Posted by vezerid

GarToms,

the following macro might give you a lead... It involves Select so
there will be some flashing on the screen. Another method could be to
modify this code to loop over all cells of origin and set values and
formats of all destination cells equal. UsedRange can make this
speedier than looping over the entire sheet.

Sub SaveSheetAsCell()
Dim newbk As Workbook
Dim oldCell As Range

Set oldCell = Selection
Set newbk = Workbooks.Add(xlWBATWorksheet)

ThisWorkbook.Sheets("Group Sign-Off").Cells.Copy
newbk.Sheets(1).Name = "Group Sign-Off"
newbk.Sheets("Group Sign-Off").Select
newbk.Sheets("Group Sign-Off").Paste

fpath = "L:\Credit Management Team\Gareth Thomas\"
fname = Sheets("Group Sign-Off").Range("d5").Value & ".xls"
newbk.SaveAs fpath & fname
newbk.Close

Application.CutCopyMode = False
oldCell.Select

End Sub

Does it help?
Kostis Vezerides