Copy Sheet To Another Workbook Issue

t0ny84

Board Regular
Joined
Jul 6, 2020
Messages
134
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
  2. Mobile
  3. Web
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)


VBA Code:
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
 

t0ny84

Board Regular
Joined
Jul 6, 2020
Messages
134
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
  2. Mobile
  3. Web
Actually I spoke to soon... It's still broken!
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Watch MrExcel Video

Forum statistics

Threads
1,128,129
Messages
5,628,869
Members
416,347
Latest member
AT2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top