CODEWITHSUNDEEP
excelvbaexcel-2007
Jon
Jon

Reputation: 433

Creating a new workbook and copying worksheets over

The problem in question centers around one workbook which contains all of my data and breakdowns spread across a ton of worksheets. I'm trying to get macros set up to copy select sheets to a new workbook. I think my biggest problem is getting the coding right for the destination workbook since the name includes a date string that changes each day. The code that I've got so far to just create the new workbook and close it is:

Sub NewReport()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    MyDate = Date

    Dim dateStr As String
    dateStr = Format(MyDate, "MM-DD-YY")

    Set W = Application.Workbooks.Add

    W.SaveAs Filename:="N:\PAR\" & "New Report Name" & " " & dateStr, FileFormat:=51

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    ActiveWorkbook.Close True
End Sub

This works and does what I want in regards to creating the new document, naming it the way it should be named, and at the end closing it. What I need help with is that middle portion for copying specific sheets from the original workbook to this new one. What I was thinking was along the lines of:

 With Workbooks("Original Workbook.xlsm")
            .Sheets(Array("Sheet1", "Sheet2")).Copy_ Before:=Workbooks("destination.xls").Sheet1

Or at least some type of array to get exactly what I want to copy over. The biggest sticking point is getting the destination workbook path name correct. Any advice regarding individual pieces of this little project or on the whole is greatly appreciated. Thanks!

EDIT: I also need to point out that the new workbook being generated needs to be just plain old excel format (.xlsx). No macros, no security warning for automatic updating links or enabling macros, zip. Just a plain book of the sheets I tell it to put there.

Upvotes: 3

Views: 43378

Answers (3)

Jon
Jon

Reputation: 433

Ok. I finally got it working now. Sheet names are carried over (otherwise I would have to go behind and rename them); it saves one copy to be sent and one copy to our archive folder; and the new workbooks don't get any popup about enabling macros or updating links. The code I finally settled on (which could probably be trimmed a little) is:

Sub Report()

    Dim Wb1 As Workbook
    Dim dateStr As String
    Dim myDate As Date
    Dim Links As Variant
    Dim i As Integer

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

    Set Wb1 = ActiveWorkbook

    myDate = Date

    dateStr = Format(myDate, "MM-DD-YYYY")

    Wb1.Sheets(Array("Sheet1Name", "Sheet2Name", "etc."))Copy

    With ActiveWorkbook
    Links = .LinkSources(xlExcelLinks)
    If Not IsEmpty(Links) Then
        For i = 1 To UBound(Links)
            .BreakLink Links(i), xlLinkTypeExcelLinks
        Next i
    End If

    End With

    ActiveWorkbook.SaveAs Filename:="N:\" & "Report Name" & " " & dateStr, FileFormat:=51
    ActiveWorkbook.SaveAs Filename:="N:\Report Archive\" & "Report Name" & " " & dateStr, FileFormat:=51

    ActiveWorkbook.Close

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Hope that'll help someone else with the same issue!

Upvotes: 2

brettdj
brettdj

Reputation: 55682

You can make your code fully variable rather than harcoding "Orginal Workbook.xlsm" and the Sheet1 and Sheet2 names

If you use two Workbook variables then you can set the ActiveWorbook (ie the one currently selected in Excel) as the workbook to be copied (alternatively you can set it to a closed workbook, existing open named workbook, or the workbook that contains the code).

With a standard 

Application.Workbooks.Add

you will get a new workbook with the number of sheets installed as per your default option (normnally 3 sheets) By specifying

 Application.Workbooks.Add(1)

a new workbook is created with only one sheet

And note I disabled macros by setting EnableEvents to False but it would be unusual to have application events running when creating workbooks

Then when copying the sheet use

 Sheets(Array(Wb1.Sheets(1).Name, Wb1.Sheets(2).Name)).Copy 
 'rather than
 Sheets(Array("Sheet1", "Sheet2")).Copy

to avoid hardcoding the sheet names to be copied. This code will copy the two leftmoast sheets irrespective of naming

Lastly the initial single sheet is removed leaving you with a new file with only the two copied sheets inside

Sub NewReport()
    Dim Wb1 As Workbook
    Dim Wb2 As Workbook
    Dim dateStr As String
    Dim myDate As Date

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

    Set Wb1 = ActiveWorkbook

    myDate = Date

    dateStr = Format(myDate, "MM-DD-YY")

    Set Wb2 = Application.Workbooks.Add(1)
    Wb1.Sheets(Array(Wb1.Sheets(1).Name, Wb1.Sheets(2).Name)).Copy Before:=Wb2.Sheets(1)
    Wb2.Sheets(Wb2.Sheets.Count).Delete
    Wb2.SaveAs Filename:="c:\test\" & "New Report Name" & " " & dateStr, FileFormat:=51

    Wb2.Close
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Upvotes: 1

chris neilsen
chris neilsen

Reputation: 53126

Your copy line should be

Workbooks("Original Workbook.xlsm").Sheets(Array("Sheet1", "Sheet2")).Copy _
 Before:=W.Sheets(1)

Upvotes: 1

Related Questions