Copy Workbook
 

Hello All.

I have this sequence running below which works just as required,
however I now need to apply it to the entire workbook as opposed to a
single sheet within the workbook.
Is there a way to run this without listing each and every sheet while
still copying formats /colours / and breaking the links?

Set srcWB = ActiveWorkbook
'copy sheet into new workbook
srcWB.Sheets("xxxxxxxx").Copy
Set destWB = ActiveWorkbook
'copy the funky colours from the report workbook
destWB.Colors = srcWB.Colors
'make the lookup section into values
With ActiveSheet.Range("AM2:AX185")
..Value = .Value
End With
ActiveSheet.Range("A1").Select
'rename sheet
ActiveSheet.Name = "xxxxxx - " & Format(Date, "yyyymmdd")
'break links
ActiveWorkbook.BreakLink Name:= _
"xxxxxxxxxxxx", Type:=xlExcelLinks
'save in archive folder
ReportFilename = _
"xxxxxxxxxxxx" & _
"xxxxxxxxxx " & ".xls"
destWB.SaveAs Filename:=ReportFilename
'close file
destWB.Close


Thanks in advance

Kristan


--
Kstalker
------------------------------------------------------------------------
Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699
View this thread: http://www.excelforum.com/showthread...hreadid=489688

Copy Workbook
 

Hi Kristan,

Try something like:

'=========
Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet

Set WB = ActiveWorkbook
WB.Save

For Each SH In srcWB.Worksheets
'make the lookup section into values
With SH.Range("AM2:AX185")
Value = .Value
End With

'rename sheet
SH.Name = SH.Name & Format(Date, "yyyymmdd")
Next SH

'break links
WB.BreakLink Name:= _
"xxxxxxxxxxxx", Type:=xlExcelLinks

'save in archive folder
ReportFilename = _
"xxxxxxxxxxxx" & _
"xxxxxxxxxx " & ".xls"

WB.SaveAs Filename:=ReportFilename

ActiveWorkbook.Close

End Sub
'<<=========



---
Regards,
Norman



"Kstalker" wrote in
message ...

Hello All.

I have this sequence running below which works just as required,
however I now need to apply it to the entire workbook as opposed to a
single sheet within the workbook.
Is there a way to run this without listing each and every sheet while
still copying formats /colours / and breaking the links?

Set srcWB = ActiveWorkbook
'copy sheet into new workbook
srcWB.Sheets("xxxxxxxx").Copy
Set destWB = ActiveWorkbook
'copy the funky colours from the report workbook
destWB.Colors = srcWB.Colors
'make the lookup section into values
With ActiveSheet.Range("AM2:AX185")
Value = .Value
End With
ActiveSheet.Range("A1").Select
'rename sheet
ActiveSheet.Name = "xxxxxx - " & Format(Date, "yyyymmdd")
'break links
ActiveWorkbook.BreakLink Name:= _
"xxxxxxxxxxxx", Type:=xlExcelLinks
'save in archive folder
ReportFilename = _
"xxxxxxxxxxxx" & _
"xxxxxxxxxx " & ".xls"
destWB.SaveAs Filename:=ReportFilename
'close file
destWB.Close


Thanks in advance

Kristan


--
Kstalker
------------------------------------------------------------------------
Kstalker's Profile:
http://www.excelforum.com/member.php...o&userid=24699
View this thread: http://www.excelforum.com/showthread...hreadid=489688