Samson92
Samson92

Reputation: 13

Copy multiple sheets from one workbook to a new one, but copy values not formulas. Then save in current directory as today's date

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

Answers (1)

Luis Curado
Luis Curado

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

Related Questions