t0ny84
Board Regular
- Joined
- Jul 6, 2020
- Messages
- 205
- Office Version
- 365
- 2016
- 2013
- Platform
- Windows
- Mobile
- 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)
Thanks in advance,
t0ny84
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