What's wrong with this "For Each Worksheets" loop? Subscript out of range.

[RockandGrohl]

Dim NameString As String, RepYear As String, Filename As String, DirectoryName As String, PathName As String, DefaultPath As String, wbyr As String
Dim sht As Worksheet
Dim Lastrow As Long, LastrowBD As Long, LastCol As Long

wbyr = 2021

ControlPanel.Hide

Set t3 = Worksheets("T3 Data")
Set bd = Worksheets("Booking Database")
Set comm = Worksheets("Comm Matrix")
Set weksum = Worksheets("Weekly")
Set monsum = Worksheets("Monthly")
Set consum = Worksheets("Contract")
Set refsum = Worksheets("TourRef")
Set feasum = Worksheets("Features")
Set namsum = Worksheets("Tourname")
Set tcatsum = Worksheets("Tourcat")
Set catsum = Worksheets("Category")
Set depsum = Worksheets("Departure")
Set dursum = Worksheets("Duration")
Set ltsum = Worksheets("Lead Time")

t3.Activate
Range("D1").FormulaR1C1 = "=TODAY()-CHOOSE(WEEKDAY(TODAY()),6,0,1,2,3,4,5)"
rdate = Range("D1").Value

MyBook = ActiveWorkbook.Name
Workbooks.Add
NewBook = ActiveWorkbook.Name

' Copy report sheets only over
Workbooks(MyBook).Activate
For Each sht In Worksheets
    If sht.Name <> "SQL" And sht.Name <> "T3 Data" And sht.Name <> "URL" And sht.Name <> "Booking Database" And sht.Name <> "Comm Matrix" Then
   sht.Copy after:=NewBook.Sheets(Sheets.Count) 'Have also tried sht.Copy after:=Workbooks(NewBook).Sheets(Sheets.Count)
    End If
Next sht

' Remove crud sheets
NewBook.Activate
Application.DisplayAlerts = False
Worksheets("Sheet 1").Delete
Worksheets("Sheet 2").Delete
Worksheets("Sheet 3").Delete
Application.DisplayAlerts = True

Hi all, failing on "sht.copy after:=" etc. I just want to take a sheet and copy it to the "NewBook" at the very end of however many sheets there may be. And then delete the first three blank sheets that come with a new workbook.

Cheers!

 

[steve the fish]

How about:

NewBook.Sheets(NewBook.Sheets.Count)

Your count was counting the sheets in the active workbook not the new book.

 

[RockandGrohl]

Private Sub Extract_Click()

Dim NameString As String, RepYear As String, Filename As String, DirectoryName As String, PathName As String, DefaultPath As String, wbyr As String
Dim sht As Worksheet
Dim t3 As Worksheet
Dim bd As Worksheet
Dim comm As Worksheet
Dim weksum As Worksheet
Dim monsum As Worksheet
Dim consum As Worksheet
Dim refsum As Worksheet
Dim feasum As Worksheet
Dim namsum As Worksheet
Dim tcatsum As Worksheet
Dim catsum As Worksheet
Dim depsum As Worksheet
Dim dursum As Worksheet
Dim ltsum As Worksheet

Dim Lastrow As Long, LastrowBD As Long, LastCol As Long

'Dim MyBook As Workbook
'Dim NewBook As Workbook

Application.ScreenUpdating = False

wbyr = 2021

ControlPanel.Hide

Set t3 = Worksheets("T3 Data")
Set bd = Worksheets("Booking Database")
Set comm = Worksheets("Comm Matrix")
Set weksum = Worksheets("Weekly")
Set monsum = Worksheets("Monthly")
Set consum = Worksheets("Contract")
Set refsum = Worksheets("TourRef")
Set feasum = Worksheets("Features")
Set namsum = Worksheets("Tourname")
Set tcatsum = Worksheets("Tourcat")
Set catsum = Worksheets("Category")
Set depsum = Worksheets("Departure")
Set dursum = Worksheets("Duration")
Set ltsum = Worksheets("Lead Time")

t3.Activate
Range("D1").FormulaR1C1 = "=TODAY()-CHOOSE(WEEKDAY(TODAY()),6,0,1,2,3,4,5)"
rdate = Range("D1").Value

Dim MyBook As Workbook
Dim NewBook As Workbook

Set MyBook = ThisWorkbook
Workbooks.Add
Set NewBook = ActiveWorkbook

' Copy report sheets only over
MyBook.Activate
For Each sht In Worksheets
    If sht.Name <> "SQL" And sht.Name <> "T3 Data" And sht.Name <> "URL" And sht.Name <> "Booking Database" And sht.Name <> "Comm Matrix" Then
    sht.Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
    End If
Next sht

' Remove crud sheets
NewBook.Activate
Application.DisplayAlerts = False
Worksheets("Sheet 1").Delete
Worksheets("Sheet 2").Delete
Worksheets("Sheet 3").Delete
Application.DisplayAlerts = True

Sorted.

Didn't declare worksheets as worksheets, standard practice.

Was following some guy who declared Workbooks as names, what I did was DIM the MyBook and NewBook, and then set them as "ThisWorkbook" and "ActiveWorkbook" which then allowed them to be selected as a paste destination.

 

[RoryA]

NewBook is a string, so you need:

sht.Copy after:=Workbooks(NewBook).Sheets(Workbooks(NewBook).Sheets.Count)

 

[steve the fish]

Oh yes surprising what you dont see when you just assume.

 

[RockandGrohl]

Cheers guys!