RockandGrohl
Well-known Member
- Joined
- Aug 1, 2018
- Messages
- 790
- Office Version
- 365
- Platform
- Windows
VBA Code:
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!