Copy Workbook

[Kstalker]

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

 

[Norman Jones]

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