Thanks, Rudi. I will try it, but can you tell me the line that was screwing everything up? I have spent some time adding some bells and whistles this morning, so I don't want to mess everything up again. I'll try this on a backup copy.
Thanks for looking at it again - I will let you know shortly.
My code now looks like this (I am quite proud of it as a VBA novice):
Private Sub CheckBox1_Click()
Dim N As Single
If CheckBox1.Value = True Then
For N = 0 To LstPrint.ListCount - 1
LstPrint.Selected(N) = True
Next N
Else
For N = 0 To LstPrint.ListCount - 1
LstPrint.Selected(N) = False
Next N
End If
End Sub
Private Sub UserForm_Initialize()
Dim sh As Worksheet
With LstPrint
.Clear
For Each sh In Worksheets 'Sets worksheets to be excluded from selection list
If sh.Name <> "1. Staff List & Subjects" And sh.Name <> "2. Staff Allocation Checklist" And sh.Name <> "3. Roles & Responsibilities" And sh.Name <> "Proforma" 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 'Sets the count of workbooks selected for export
Dim i As Long 'Sets the workbookt o scroll all worksheets back to the top before exporting
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
For i = 1 To ThisWorkbook.Sheets.Count
Application.Goto reference:=Sheets(i).Range("A1"), Scroll:=True
Next i
'///// COPY SECTION /////
If LstPrint.Selected(x) = True Then
Application.CopyObjectsWithCells = False
With Sheets(LstPrint.List(x))
.Unprotect
.Copy
End With
'///// PASTE SECTION /////
Application.CopyObjectsWithCells = False
With Sheets(Sheets.Count)
.Unprotect
.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
.Protect
End With
'///// EXPORT SECTION /////
With ActiveWorkbook
.Sheets(Sheets.Count).Protect
.Sheets(Sheets.Count).Name = LstPrint.List(x)
If .HasVBProject Then
FileFormatNum = 52
Else
FileFormatNum = 51
End If
.SaveAs FolderName & "\" & LstPrint.List(x), FileFormatNum
.Close False
End With
'///// TIDY WORKBOOK SECTION /////
For Each Sheet In ActiveWorkbook.Worksheets
If Sheet.Name = LstPrint.List(x) & " (#)" Then
Application.DisplayAlerts = False
Worksheets(LstPrint.List(x) & " (#)").Delete
Application.DisplayAlerts = True
End If
Next Sheet
End If
Next
'///// RESET FOCUS SECTION /////
Application.ScreenUpdating = True
Unload Me 'Unloads user form
Application.Goto Sheets("1. Staff List & Subjects").Range("A1") 'Returns focus to first sheet of workbook
Call Shell("explorer.exe " & FolderName, vbNormalFocus) 'Opens folder containing esported workbooks
End Sub
Bookmarks