Copy Sheet To Another Workbook Issue

[t0ny84]

Hi,

I hope someone can tell me where I am wrong with this code.

The purpose of the code is to:
- Check if backup folder is created.
- If its created then it checks if XLSX file (based on number entered by user) is in the folder.
- If it isn't then it will create the workbook.
- If it is then it will open and add a copy of the sheet to the end of the workbook.

I had this working but for some reason it is no longer working when it gets to the below line it spits out a "Run-time Error '9'. Subscript out of range" Error!
I have this in a Module if this makes any difference.

ThisWorkbook.ActiveSheet.Copy After:=DestWbk.Worksheets(Sheets.Count)

Sub BackUpSheet()
Call SpeedUpOn
' Used to back up sheets
' To use this you must set a reference for Scripting Runtime
' --------------------------------------------------
' 1.  In the VBE window, Choose Tools | References
' 2.   Check the box for Microsoft Scripting Runtime
' --------------------------------------------------

Dim BackupFolderPath As String
Dim BackupFileExists As String
Dim FName As String
Dim FName_Year As String
Dim MonthQ As String

Dim NewBook As Workbook
Dim DestBook As Workbook

Dim fso As FileSystemObject

Set fso = CreateObject("Scripting.FileSystemObject")
   
FName_Year = Application.InputBox("Enter the year the backup relates to (e.g. 2020")
If FName_Year = vbCancel Then
Call SpeedUpOff
Exit Sub
End If

FName = FName_Year & "_.xlsx" 'Year(Now)
BackupFolderPath = "BACKUP FOLDER PATH"
BackupFileExists = BackupFolderPath & "\" & FName

' Checks if BackUp Folder Exists
' If it doesn't then it creates it, if it does then it skips this step.

If fso.FolderExists(BackupFolderPath) = False Then
fso.CreateFolder (BackupFolderPath)
End If        '

' Double checks backup folder exists and also checks if backup file exists.
If fso.FolderExists(BackupFolderPath) Then
If fso.FileExists(BackupFileExists) = False Then

MonthQ = Application.InputBox("Enter Month Number Scheduled e.g. 1 For January", "Enter Month")
If MonthQ = False Then
Exit Sub
End If

Set NewBook = Workbooks.Add

ThisWorkbook.ActiveSheet.Copy After:=NewBook.Sheets(Sheets.Count)

With NewBook
.ActiveSheet.Name = MonthName(MonthQ) & Round(1 + Rnd + 2) 'This adds a random number of 1 + 2 + Random Number to the end of the file name.
.ActiveSheet.Shapes("Group 1").Delete
.ActiveSheet.Shapes("Group 11").Delete
.ActiveSheet.Rows("1:8").Delete
.ActiveSheet.Range("B1").Value = MonthName(MonthQ) & " - " & FName_Year & " Sessions"
.SaveAs Filename:=BackupFolderPath & "\" & FName_Year & "_.xlsx"
.Close
End With

MsgBox "Schedule for " & MonthName(MonthQ) & " has been exported"
Else
   
' File Exists - Opens Workbook and adds a copy to the workbook then saves and closes it.

MonthQ = Application.InputBox("Enter Month Number Scheduled e.g. 1 For January", "Enter Month")
If MonthQ = False Then
Call SpeedUpOff
Exit Sub
Else

Set DestWbk = Workbooks.Open(BackupFileExists)
'Workbooks.Open BackupFileExists
   
ThisWorkbook.ActiveSheet.Copy After:=DestWbk.Worksheets(Sheets.Count)

With DestWbk
With .ActiveSheet
.Name = MonthName(MonthQ) & Round(1 + Rnd + 2) 'This adds a rounded random number of 1 + 2 + Random Number to the end of the file name.
.Shapes("Group 1").Delete
.Shapes("Group 11").Delete
.Rows("1:8").Delete
.Range("B1").Value = MonthQ & " - " & Yearq & " Sessions"
End With
.Save
.Close
End With

MsgBox "Schedule for " & MonthName(MonthQ) & " has been exported"

End If
End If
End If
Call SpeedUpOff
End Sub

Thanks in advance,
t0ny84

 

[MARK858]

What happens with

ThisWorkbook.ActiveSheet.Copy After:=DestWbk.Worksheets(DestWbk.Sheets.Count)

 

[t0ny84]

What happens with

ThisWorkbook.ActiveSheet.Copy After:=DestWbk.Worksheets(DestWbk.Sheets.Count)

Hey Mark it gives a run time Error '9'. Subscript out of range" Error

 

[MARK858]

What does DestWbk show when the error happens?

 

[t0ny84]

What does DestWbk show when the error happens?

Debug.Print shows the backup workbook name Sessions.xlsx

 

[VBasic2008]

You are 'mixing' sheets with worksheets.

If you have a chart in destination workbook, the error will surely occur.
Try the following:

ThisWorkbook.ActiveSheet.Copy After:=DestWbk.Sheets(DestWbk.Sheets.Count)

 

[t0ny84]

You are 'mixing' sheets with worksheets.

If you have a chart in destination workbook, the error will surely occur.
Try the following:

ThisWorkbook.ActiveSheet.Copy After:=DestWbk.Sheets(DestWbk.Sheets.Count)

Hey VBasic2008, this gives an error of Run-Time Error -2147417848 (80010108)
Automation Error
The object invoked has disconnected from its clients.

 

[MARK858]

Do you get the same error with

Set DestWbk = Nothing
Set DestWbk = Workbooks.Open(BackupFileExists)
'Workbooks.Open BackupFileExists
   
ThisWorkbook.ActiveSheet.Copy After:=DestWbk.Sheets(DestWbk.Sheets.Count)

 

[t0ny84]

Do you get the same error with

Set DestWbk = Nothing
Set DestWbk = Workbooks.Open(BackupFileExists)
'Workbooks.Open BackupFileExists
 
ThisWorkbook.ActiveSheet.Copy After:=DestWbk.Sheets(DestWbk.Sheets.Count)

Same error unfortunately.

I forgot to mention as well even though it gets the error it still copies the sheet to the end of the workbook.
The other steps after copying don't process after this.

 

[t0ny84]

Update - the issue is fixed! Steps below how I fixed it in case someone else comes across this issue in the future!

It doesn't look like it was a code issue but an Excel\Workbook issue (don't know exactly).

I recently started noticing when I would try and exit either this workbook or the test backup workbook when the code errored I couldn't I would only get a spinning blue wheel. To exit I would need to use Windows Task Manager.

As the code previously had worked and I couldn't identify anything wrong with it (not that there isn't) I copied the code and pasted it into a blank workbook, the code worked exactly like it should in the new workbook. This led me to believe it was the module\workbook issue rather than code.

Steps:
1) Exported Module
2) Deleted Module
3) Saved Workbook
4) Reopened Workbook
5) Imported Module
6) Ran Code and no issues.
7) Saved Workbook
8) Happy Dance!?

Thanks everyone for your help, hopefully doing above has fixed it for the future...

t0ny84