DIR loop with specific sheet names - vba

Question

I have 5 files in a folder. I need to split a sheet called Marrs Upload into a separate worksheet.
I've managed to get it to work for the first file but after that it comes up with the "Run Time error: 9 Subscript out of range" message.
Here is my current code:
Sub Hello()
StrFile = Application.ActiveWorkbook.Path + "\" 'Get path name
GetFullFile = ActiveWorkbook.Name 'File name
sFilename = Left(GetFullFile, (InStr(GetFullFile, ".") - 1)) 'Fine the . and
i = 1 'Part of the name counter
ExportFile = StrFile + "Import to Marrs\"
SaveAsFileName = "Marrs Upload " & Format(Date, "dd-mm-yyyy ") ' Saves the filename Marrs Upload (Date) followed by counter
Application.DisplayAlerts = False
strFilename = Dir(StrFile)
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder
Do Until strFilename = ""
Sheets("Marrs Upload").Move ' Moves Marrs Upload tab
ActiveWorkbook.Close (False)
ActiveWorkbook.SaveAs (ExportFile & SaveAsFileName & i)
'ActiveWorkbook.Close (False)
'ActiveWorkbook.Close (False)
i = i + 1
strFilename = Dir()
Loop
End Sub
I've tried most things and cannot get any further.
Kind Regards,
Ashley
I've added to original code to only work if a certain sheet name exists.
Sub Hello()
StrFile = Application.ActiveWorkbook.Path + "\" 'Get path name
GetFullFile = ActiveWorkbook.Name 'File name
sFileName = Left(GetFullFile, (InStr(GetFullFile, ".") - 1)) 'Find the . and returns only file name minus extension
i = 1 'Counter
ExportFile = StrFile + "Import to Marrs\" 'Saves new worksheet in a specific folder
SaveAsFileName = "Marrs Upload " & Format(Date, "dd-mm-yyyy ") ' Saves the filename Marrs Upload (Date) followed by counter
Application.DisplayAlerts = False 'Don't display alerts "Overwrite, ect"
StrFileName = Dir(StrFile) 'No extension as can be a combination of .xlsm and .xls
Do While Len(StrFileName) > 0 'Loop when files are in DIR
If CheckSheet("Marrs Upload") Then 'if workseet contains a tab called "Marrs Upload" then continue.
Sheets("Marrs Upload").Move ' Moves Marrs Upload tab
ActiveWorkbook.SaveAs (ExportFile & SaveAsFileName & i) 'Save worksheet as Marrs Upload (Date) (Counter)
ActiveWorkbook.Close (False) 'Don't need to save original file (Audit Trail)
i = i + 1 'Increase counter by 1
End If
StrFileName = Dir() 'used when worksheet doesn't contain sheet called "Marrs Upload"
Loop
End Sub
Function CheckSheet(ByVal sSheetName As String) As Boolean
Dim oSheet As Worksheet
Dim bReturn As Boolean
For Each oSheet In ActiveWorkbook.Sheets
If oSheet.Name = sSheetName Then
bReturn = True
Exit For
End If
Next oSheet
CheckSheet = bReturn
End Function
Kind Regards,
Ashley

Answer 1

EDIT: Tested, and works for me.
Sub Hello()
Dim SourceFolder As String, DestFolder As String
Dim f As String, SaveAsFileName As String, sFileName As String
Dim i As Long, wb As Workbook
'*** if ActiveWorkbook has the macro, safer to use ThisWorkbook
SourceFolder = Application.ActiveWorkbook.Path + "\"
DestFolder = SourceFolder & "Import to Marrs\"
'*** what are you doing with this?
sFileName = Left(ActiveWorkbook.Name, _
(InStr(ActiveWorkbook.Name, ".") - 1))
' Saves the filename Marrs Upload (Date) followed by counter
SaveAsFileName = "Marrs Upload " & Format(Date, "dd-mm-yyyy ")
Application.DisplayAlerts = False
i = 1 'Part of the name counter
f = Dir(SourceFolder & "*.xls*") '*** use wildcard for XL files only
Do While Len(f) > 0
Debug.Print f
Set wb = Workbooks.Open(SourceFolder & f)
If CheckSheet(wb, "Marrs Upload") Then
wb.Sheets("Marrs Upload").Move ' Moves Marrs Upload tab
'*** the wb with the moved sheet is now active: save it
With ActiveWorkbook
.SaveAs (DestFolder & SaveAsFileName & i)
.Close True
End With
i = i + 1
End If
wb.Close False '***close the one we just opened. Not saving?
f = Dir() '*** next file
Loop
End Sub
Function CheckSheet(wb as WorkBook, ByVal sSheetName As String) As Boolean
Dim oSheet As Worksheet
Dim bReturn As Boolean
For Each oSheet In wb.WorkSheets
If oSheet.Name = sSheetName Then
bReturn = True
Exit For
End If
Next oSheet
CheckSheet = bReturn
End Function