Copy every worksheet

[QB]

I need to copy each worksheet from the active workbook into a new workbook.
I've been fighting with the following code and am hoping can point out my
mistake.

Set DataWrkBk = Workbooks(ActiveWorkbook.Name)
Workbooks.Add
Sheets("Sheet1").Select
Set NewWrkBk = ActiveWorkbook
NewWrkBkName = ActiveWorkbook.Name

Windows("Weekly_Stats.xls").Activate
For Each ws In DataWrkBk.Worksheets
wSheet.Copy After:=NewWrkBk.Worksheets(NewWrkBk.Worksheets.Count)
Debug.Print ws.Name
Next ws

It does the first sheet fine and then spits out an error:424 object required
and highlights the wSheet.Copy line? Why would it work once and then stop?

Thank you for the helping hand.

QB

 

[Dave Peterson]

You could try:

datawrkbk.sheets.copy
or
datawkrbk.worksheets.copy

(don't create the "to" workbook first, either. The .copy will do that for you.)

ps.

Set DataWrkBk = Workbooks(ActiveWorkbook.Name)
is the same thing as:
Set DataWrkBk = ActiveWorkbook

 

[john]

If you are attempting to make a copy of the active workbook have you thought
about using SaveCopyAs?

from the help file:

Example
This example saves a copy of the active workbook.

ActiveWorkbook.SaveCopyAs "C:\TEMP\XXXX.XLS"

 

[Steve Yandl]

QB,

The sub below will copy the sheets in the active workbook to a new workbook
and activate the new workbook. Values, formatting and any VBA code attached
to the specific sheets will be retained in the new book, VBA code attached
to the Workbook or in any modules will be left behind.

'-----------------------------------------
Sub CopyToNewBook()

Dim s As Integer
Dim b As Integer
Dim vArray As Variant

s = Application.Worksheets.Count
b = Application.Workbooks.Count

ReDim vArray(s - 1)

For x = 0 To s - 1
vArray(x) = Worksheets(x + 1).Name
Next x

Worksheets(vArray).Copy

Set objNewBook = Application.Workbooks(b + 1)
objNewBook.Activate


End Sub

'-----------------------------------------

Steve Yandl