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.

 

[waldymar]

Yeah, I'll PM you my email address but it might have to wait until I'm not at work.

Great! No problem, I will wait! Sorry again for disturbing!

 

[RichardMGreen]

No problem.
Be nice to get this one sorted.

 

[RichardMGreen]

I've just checked the details using the file you sent me and it works fine for me. I did have an issue in that I onle have Excel 2003 so anything past IV65536 was lost.

I ran the code in the workbook (slightly modified) and it works OK for me. All the range references in the graphs became numbers without a problem.

Here's the updated code:-

Sub Moving()
    Dim varPath As String, WbOpen As Workbook
    Application.ScreenUpdating = False
    Set WbOpen = Workbooks.Add
    varPath = coding.Range("b1").Value
    currdashboard.Copy before:=WbOpen.Sheets(1)
    Application.DisplayAlerts = False
    WbOpen.SaveAs varPath & "\Currency and Interest Rate Dashboard-" & Format(Date, "dd-mmm-yyyy") & ".xlsx"
    Application.DisplayAlerts = True
    Cells.Copy
    Cells.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    WbOpen.Close savechanges:=True
    Application.ScreenUpdating = True
End Sub
Sub save_file()
    Dim twb As Workbook, wb As Workbook
    Set twb = ThisWorkbook
    new_sheet_counter = Application.SheetsInNewWorkbook
    Set wb = Workbooks.Add
'----- Copy relevant worksheets to new book -----
    twb.Sheets("Currency Dashboard").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)
            Application.CutCopyMode = False
            ws.Range("A1").Select
        Next
        wb.Sheets("Currency Dashboard").Select
        Application.Wait Now() + TimeValue("00:00:01")
        wb.BreakLink Name:=ThisWorkbook.Name, Type:=xlExcelLinks
    End With
    Application.DisplayAlerts = True
'----- Set up variables for saving report -----
    reportingdate = Format(Date, "dd-mmm-yyyy")
    outputlocation = coding.Range("b1")
    If Right(outputlocation, 1) <> "\" Then outputlocation = outputlocation & "\"
    vsion = 1
'----- Save new workbook with version control -----
    Application.DisplayAlerts = False
    wb.SaveAs Filename:=outputlocation & "Currency and Interest Rate Dashboard-" & reportingdate & " v" & vsion & ".xlsx"
    wb.Close False
    Application.DisplayAlerts = True
End Sub
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

I've been looking at the formula version you sent me.

Let me know how you get on with the updated code.