Renaming a sheet and file name

Hi,

I have two macros that do the same task but i need to amend them both slightly and I require some help please...

In the code:

Sub Splitter(): Dim PC As Object, TB As String, UR As Range, P As String
Dim ws As Worksheet, wb As Workbook, n As Long, BN As String, K
Set PC = CreateObject("Scripting.Dictionary")
Set ws = Sheets("Data"): Set UR = ws.UsedRange: n = 2
TB = "-TrialBalance-062018"
P = ws.Parent.Path 'Enter the Path for the folder where you want the Output
Do Until ws.Cells(n, 2) = "": BN = Trim(ws.Cells(n, 2))
If Not PC.Exists(BN) Then PC.Item(BN) = n
n = n + 1: Loop: K = PC.Keys()
For n = 0 To UBound(K): BN = K(n) & TB & " " & ".XLSX"
UR.AutoFilter Field:=2, Criteria1:=K(n)
    Set wb = Workbooks.Add
UR.SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Range("A1")
wb.Sheets(1).Columns("A:D").Delete: wb.Sheets(1).Columns.AutoFit
  wb.SaveAs P & "\" & BN: wb.Close
UR.AutoFilter
Next n
End Sub

The newly created files have an additional space which I need to remove. e.g. "1010220-TrialBalance-062018 .XLS" how do I remove this?

In both codes (Splitter and Preparefiles) new sheets are created called "Sheet1". Is there any way I can change this to "Trial Balance"? I havent included the 2nd code but its within the workbook.