Solved

Excel VBA copy all sheets to new workbook

Posted on 2012-03-29
8
495 Views
Last Modified: 2012-03-29
Hi!
In Excel VBA, I want to loop through all worksheets in one workbook, and copy then to another.

This is what I have so far; when I run it I get an error.

Dim FName As String
Dim MacroBook As Workbook
Dim OutputBook As Workbook

Set MacroBook = ActiveWorkbook
FName = Sheets("INSTRUCTIONS").Range("C2").Value & " " & Sheets("INSTRUCTIONS").Range("C3").Value
If FName = " " Then MsgBox ("Enter the Vendor Name and Product Line"): Exit Sub
Set OutputBook = Workbooks.Add
Application.DisplayAlerts = False
OutputBook.SaveAs Filename:="F:\buying\catalog production\2013\" & FName & ".xls"

MacroBook.Sheets(2).Copy OutputBook(After:=wbOpen.Sheets("Sheet1"))

Open in new window

0
Comment
Question by:etech0
  • 2
  • 2
  • 2
  • +1
8 Comments
 
LVL 33

Expert Comment

by:Norie
ID: 37783890
If you want to copy all the sheets of a workbook you can use this.
ThisWorkbook.Sheets.Copy

Open in new window


The newly created workbook is now the active workbook so you can add this after the copy.
Set OutpotBook = ActiveWorkbook

OutputBook.SaveAs Filename:="F:\buying\catalog production\2013\" & FName & ".xls

Open in new window

0
 
LVL 10

Expert Comment

by:Anthony Berenguel
ID: 37783892
Because you want all of the tabs to go into a new workbook, I'm thinking another way to do this is to save the workbook as a new workbook.

Sub saveAsNewWB()

    ActiveWorkbook.SaveAs Filename:= _
        "yourNewWorkbooksFullFilePathGoesHere", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Open in new window

0
 
LVL 10

Expert Comment

by:Anthony Berenguel
ID: 37783902
Sorry for submitting a different solution. imnorie's solution wasn't visible at the time I tried to submit my solution. If I would have seen his solution I wouldn't have offered mine.
0
 
LVL 12

Expert Comment

by:kgerb
ID: 37783919
Try this.  I think it will do what you want.
Sub CopyAllWorksheets()
Dim FName As String
Dim MacroBook As Workbook
Dim OutputBook As Workbook
Set MacroBook = ThisWorkbook
'FName = Sheets("INSTRUCTIONS").Range("C2").Value & " " & Sheets("INSTRUCTIONS").Range("C3").Value
'If FName = " " Then MsgBox ("Enter the Vendor Name and Product Line"): Exit Sub
Worksheets.Copy
Set OutputBook = ActiveWorkbook
OutputBook.SaveAs Filename:="F:\buying\catalog production\2013\" & FName, FileFormat:=xlWorkbookNormal
MacroBook.Activate
End Sub

Open in new window

Kyle
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 10

Author Comment

by:etech0
ID: 37783943
The reason I need a loop is because in certain cases, I want the macro to skip a sheet.

@aebea: another reason your code wouldn't work here is because I need to keep both files open for the duration of the macro, which will be much longer when it's finished.
0
 
LVL 33

Accepted Solution

by:
Norie earned 400 total points
ID: 37783986
Which workbooks do you want to exclude?

This code will loop through the worksheets and only copy certain sheets

Dim ws As Worksheet

Dim arrWS()
Dim I As Long

For Each ws In ThisWorkbook.Worksheets
       If ws.Name <> "Sheet3" Then
            ReDim Preserve arrWS(I)
            arrWS(I) = ws.Name

            I = I + 1
       End If
       
Next ws

ThisWorkbook.Worksheets(arrWS).Copy

Set OutputBook = ActiveWorkbook

OutputBook.SaveAs Filename:="F:\buying\catalog production\2013\" & FName & ".xls"

Open in new window

0
 
LVL 12

Assisted Solution

by:kgerb
kgerb earned 100 total points
ID: 37783988
This one loops.
Sub CopyAllWorksheets()
Dim FName As String, ws As Worksheet
Dim MacroBook As Workbook
Dim OutputBook As Workbook
Set MacroBook = ThisWorkbook
FName = Sheets("INSTRUCTIONS").Range("C2").Value & " " & Sheets("INSTRUCTIONS").Range("C3").Value
If FName = " " Then MsgBox ("Enter the Vendor Name and Product Line"): Exit Sub
Application.SheetsInNewWorkbook = 1
Set OutputBook = Workbooks.Add
Application.SheetsInNewWorkbook = 3
With OutputBook
    For Each ws In MacroBook.Worksheets
        ws.Copy After:=.Sheets(.Sheets.Count)
    Next ws
    Application.DisplayAlerts = False
    .Sheets(1).Delete
    Application.DisplayAlerts = True
End With
OutputBook.SaveAs Filename:="F:\buying\catalog production\2013\" & FName, FileFormat:=xlWorkbookNormal
MacroBook.Activate
End Sub

Open in new window

Kyle
0
 
LVL 10

Author Closing Comment

by:etech0
ID: 37784043
Thanks!

imnorie: your code did the trick.

some points to kgerb as well; your code seems almost the same.
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now