VBA to Split Workbook: No Longer Working with Multi-Selection on User Form

Having solved the values issue in my previous thread, I now have a new problem.

Previous thread: https://www.excelforum.com/excel-pro...to-values.html

The code I have used to work as I wished: I was able to CTRL select one or more sheets in the user form at the beginning and these would be copied and split out as separate files. Now, if I multi-select, it only works for the first sheet, after which I get copies of the last tab in the workbook instead of the other sheets I've selected. The subsequent sheets are copied, but when it comes to splitting out, it doesn't happen.


Only this line of code executes correctly on the subsequent sheets:

.Range("H1").Value = LstPrint.List(x)

What do I need to tweak to get it to loop back to the splitting out section for each sheet? I am not able to upload a workbook at the moment as I am at work.

My code is here:

Private Sub UserForm_Initialize()
Dim sh As Worksheet
With LstPrint
    .Clear
    For Each sh In Worksheets
        If sh.Name <> "1. Staff List & Subjects" And sh.Name <> "2. Staff Allocation Checklist" And sh.Name <> "3. Roles & Responsibilities" And sh.Name <> "Proforma" And sh.Name <> "Rooms" Then .AddItem sh.Name
    Next
End With
End Sub

Private Sub CmdPrint_Click()
    Dim DateString As String
    Dim FolderName As String
    Dim x As Long
    Dim FileFormatNum As Long

    Application.ScreenUpdating = False
    DateString = Format(Now, "dd mmmm yyyy")
    FolderName = "C:\Users\Alison\OneDrive - Royal Hospital School\Documents\Timetable WIP\2019-20\Staffing Grids for HoDs" & " " & DateString
    For x = 0 To LstPrint.ListCount - 1
        If LstPrint.Selected(x) = True Then
            Application.CopyObjectsWithCells = False
            With Sheets(LstPrint.List(x))
                If .ProtectContents = True Then
                    .Unprotect
                    .Copy , Sheets(Sheets.Count)
                    .Protect
                Else
                    .Copy Sheets(Sheets.Count)
                End If
            End With
            Application.CopyObjectsWithCells = True
            With Sheets(Sheets.Count)
                .Range("H1").Value = LstPrint.List(x)
                .Range("A1").Value = .Range("A1").Value
                .Range("B2:U4").Value = .Range("B2:U4").Value
                .Range("E94:U104").Value = .Range("E94:U104").Value
                .Copy
            End With
            With ActiveWorkbook
                .Sheets(1).Protect
                .Sheets(1).Name = LstPrint.List(x)
                If .HasVBProject Then
                    FileFormatNum = 52
                Else
                    FileFormatNum = 51
                End If
                .SaveAs FolderName & "\" & LstPrint.List(x), FileFormatNum
                .Close False
            End With
        End If
    Next
    Application.DisplayAlerts = False
    Sheets(Sheets.Count).Delete
    Application.DisplayAlerts = True
    Call Shell("explorer.exe " & FolderName, vbNormalFocus)
    Application.ScreenUpdating = True
    Unload Me
    Application.Goto Sheets("1. Staff List & Subjects").Range("A1")
End Sub