Solved

Excel VBA copy all sheets to new workbook

Posted on 2012-03-29
8
547 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
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
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
 
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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

856 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