Reputation: 13
I have a workbook that contains 20+ sheets, I'm trying to create a macro that when run will copy 3 specific sheets to a new workbook, but with the values in the destination instead of the formulas, and save it as today's date and time if preferable.
I've managed to have a few attempts at doing it different ways, but no matter which way I always have a problem getting it to run successfully. The most consistent it gets is with the code below;
Sub CopyInNewWB()
Dim wbO As Workbook, wbN As Workbook
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wbO = ActiveWorkbook
Set wbN = Workbooks.Add
wbO.sheets("Tracking").Copy wbN.sheets(1)
wbO.sheets("Bridge").Copy wbN.sheets(2)
wbO.sheets("Overview (Age)").Copy wbN.sheets(3)
wbN.sheets("Sheet1").Delete
wbN.sheets("Customers").Activate
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
ErrHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
This works, as it creates a new workbook and copies those intended sheets, but it copies the formulas and references them back to the original workbook they came from. Also no matter what I add to the end, it won't save as anything but 'Book1'. Ideally it'll save in the same directory as the workbook it came from.
Upvotes: 1
Views: 67
Reputation: 766
try this
Sub CopyInNewWB()
Dim wbO As Workbook, wbN As Workbook
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wbO = ActiveWorkbook
Set wbN = Workbooks.Add
wbO.Sheets("Tracking").Copy wbN.Sheets(1)
'just a trick to "copy/paste" values
With ActiveSheet.UsedRange
.Value = .Value
End With
wbO.Sheets("Bridge").Copy wbN.Sheets(2)
wbO.Sheets("Overview (Age)").Copy wbN.Sheets(3)
wbN.Sheets("Sheet1").Delete
wbN.Sheets("Customers").Activate
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
ErrHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
u have to add
With ActiveSheet.UsedRange
.Value = .Value
End With
everytime u copy a sheet
Upvotes: 1