vba: copy&paste to a new workbook

[waldymar]

Dear All,

I created a macro which copy a spreadsheet and paste it as values in a new workbook:

[FONT=Calibri][SIZE=3]Sub Moving()[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Application.ScreenUpdating = False[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim varPath As String[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim WbOpen As Workbook[/SIZE][/FONT]<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[FONT=Calibri][SIZE=3]Set WbOpen = Workbooks.Add[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]varPath = coding.Range("b1").Value[/SIZE][/FONT]
<o:p>[FONT=Calibri][SIZE=3][/SIZE][/FONT]</o:p>
[FONT=Calibri][SIZE=3]bonddashboard.Copy before:=WbOpen.Sheets(1)[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]      [/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Application.DisplayAlerts = False[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]WbOpen.SaveAs varPath & "\Fixed Income Dashboard-" & Format(Date, "dd-mmm-yyyy") & ".xlsx"[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Application.DisplayAlerts = True[/SIZE][/FONT]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[FONT=Calibri][SIZE=3]Cells.Select[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Selection.Copy[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Application.CutCopyMode = False[/SIZE][/FONT]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[FONT=Calibri][SIZE=3]WbOpen.Close savechanges:=True[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Application.ScreenUpdating = True[/SIZE][/FONT]<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[FONT=Calibri]End Sub[/FONT]

Can anyone help me to develop a macro such as be able to copy (from the same old one) and paste as values a 2nd or 3rd spreadsheet (into the same a new one).
I would appreciate any help.

 

[RichardMGreen]

I use this code for copying multiple sheets to a new workbook:-

Sub save_file()
    new_sheet_counter = Application.SheetsInNewWorkbook
    Set wb = Workbooks.Add
'----- Copy relevant worksheets to new book -----
    twb.Sheets(Array("Front_Page", "Stage_Of_Change", "Assessments_Taken", "Care_Plan_Pt_1", _
        "Care_Plan_Pt_2", "Care_Plan_Pt_3", "Care_Plan_Pt_4", "Care_Plan_Pt_5", "Care_Plan_Pt_6", _
        "Care_Plan_Pt_7", "Care_Plan_Pt_8", "Care_Plan_Pt_9_Out-Of-Range", "Clinical_Data")).Copy after:=wb.Sheets(new_sheet_counter)
'----- Remove original worksheets and set others to values-only -----
    Application.DisplayAlerts = False
    With wb
        For counter = 1 To new_sheet_counter
            .Sheets("Sheet" & counter).Delete
        Next
        .Colors = twb.Colors
        For Each ws In wb.Worksheets
            ws.Cells.Copy
            ws.Cells.PasteSpecial (xlPasteValues)
            ws.Select
            ws.Range("A1").Select
        Next
        wb.Sheets("Front_Page").Select
    End With
    Application.DisplayAlerts = True
'----- Set up variables for saving report -----
    reportingdate = Format(Now(), " Mmmm yyyy")
    outputlocation = querydata.Range("F10")
    If Right(outputlocation, 1) <> "\" Then outputlocation = outputlocation & "\"
    vsion = 1
'----- Save new workbook with version control -----
    Do While FileExists(outputlocation & savename & reportingdate & " v" & vsion & ".xls")
        vsion = vsion + 1
    Loop
    wb.SaveAs Filename:=outputlocation & savename & reportingdate & " v" & vsion & ".xls"
    wb.Close False
End Sub

I've dimmed twb as a workbook and set it to euqal thisworkbook further up the code.

Hope this helps.

 

[waldymar]

Thank you for your macro.
Apparently, it shows me an error with "FileExists". What is that and how to solve it?
Also, I guess you missed to define the "savename".
Appreciate your response!

 

[waldymar]

Also, please it's not clear what to do with "twb"

 

[RichardMGreen]

Oops, sorry.

FileExists is a function which checks to see if a file of th given name already exists in order to save a different version number of it.
Code for it is:-

Private Function FileExists(fname) As Boolean
'----- Returns TRUE if the file exists -----
    Dim x As String
    x = Dir(fname)
    If x <> "" Then FileExists = True Else FileExists = False
End Function

Savename is a string picked from the worksheet as it is a constant in all my filenames and can be edited if necessary.

::edit::

twb needs to be DIMmed as a workbook and then you use :-
set twb=thisworkbook

 

[waldymar]

Great! Now it works! Thanks a lot!
But I still have some questions
1) Here you are hardcording:

Array("Front_Page", "Stage_Of_Change", "Assessments_Taken", "Care_Plan_Pt_1", _
        "Care_Plan_Pt_2", "Care_Plan_Pt_3", "Care_Plan_Pt_4", "Care_Plan_Pt_5", "Care_Plan_Pt_6", _
        "Care_Plan_Pt_7", "Care_Plan_Pt_8", "Care_Plan_Pt_9_Out-Of-Range", "Clinical_Data")

How can I change it in order to use the vba properties names? I mean your macro won't work if someone decided to rename the spreadsheets name.
2) If I have graphs in my spreadsheet and even if it's pasting as values the graphs keep their source path. Therefore it's always will adjust to the current figures. Do you have any idea how to paste the graphs as image or anything else without keeping links to the source?

Much appreciate!

 

[RichardMGreen]

With the graphs, once the relevant worksheets have been copied to the new workbook, you can use breaklinks to force the series details into values. I've found you need to put a short delay in (application.wait now()=timevalue("00:00:01") works for me) or it falls over.

You can change the sheet names to anything you want providing you keep the format the same. So this should work as well:-

Array(sheets(1), sheets(2), sheets(3), ....... sheets(99))

 

[waldymar]

Array(sheets(1), sheets(2), sheets(3), ....... sheets(99))

ups, it doesn't work. I wrote like this:

Array(bonddashboard, bonddashboard1, bonddashboard2)

but it gives me an error. Can you please check in your sheet?

Sorry, I didn't understand about graphs. Would you be so kind to show it specifically on the same macro. I guess some new codes should be written in this area:

For Each ws In wb.Worksheets
            ws.Cells.Copy
            ws.Cells.PasteSpecial (xlPasteValues)
            ws.Select
            ws.Range("A1").Select
        Next

Thanks in advance!

 

[RichardMGreen]

What error do you get for the array?
After you do the worksheet copying, you need:-

application.wait now()+timevalue("00:00:01")
wb.BreakLink Name:=ThisWorkbook.Name, Type:=xlExcelLinks

wb is the name of your created workbook where the sheets are copied to.

I've just tested some code with a chart sheet in place and it seems to work around it. Let me know how you get on.

 

[waldymar]

You mean this:

For Each ws In wb.Worksheets
            ws.Cells.Copy
            [COLOR=blue]application.wait now()+timevalue("00:00:01")
            wb.BreakLink Name:=ThisWorkbook.Name, Type:=xlExcelLinks
[/COLOR]            ws.Cells.PasteSpecial (xlPasteValues)
            ws.Select
            ws.Range("A1").Select
        Next