OK, so I'm testing some code. It works to a point on step through. It's a loop with a lot of data so I can't step through it all. However when I want to carry out a test run the code doesn't execute. I can't see why. Any help greatly appreciated. Here is the code.
Code
Sub SplitDataToUniqueWorkBook()
Dim rCl As Range, rRng As Range
Dim fName As String, SvPath As String
Dim Mth As Integer
Dim LR As Long
Dim wsData As Worksheet
Dim rngData As Range
MsgBox "Please select a folder to save the completed files"
Application.FileDialog(msoFileDialogFolderPicker).Show
SvPath = CurDir & "\"
Mth = InputBox("Enter the current reporting month", "Reporting month entry")
With Sheets("Data")
.Range("AJ1").EntireColumn.Delete
.Range("A4").CurrentRegion.Columns(25).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet4.Range( _
"AJ4"), Unique:=True
Set rRng = .Range(.Cells(5, 36), .Cells(.Rows.Count, 36).End(xlUp))
End With
For Each rCl In rRng
fName = rCl.Value
Sheets("Referrals").Range("A4").CurrentRegion.Clear
With Sheets("Data")
.Range("AH5").Value = rCl.Value
.Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("AH4:AH5"), CopyToRange:=Sheets("Referrals").Range("A4"), Unique:=False
End With
ThisWorkbook.Sheets(Array("Source of Referral", "GP Referrals", "Referrals")).Copy
ActiveWorkbook.SaveAs SvPath & fName & " - M" & Mth & " .xlsx", _
FileFormat:=51, CreateBackup:=False
ActiveWorkbook.Close True
Next rCl
End Sub
Display More