Split Large Range Into Separate Worksheets

The following code takes a large range of data (currently 20K+ rows) and breaks it out into separate worksheets. This takes a while, and I have been trying to insert a progress bar into this macro, but the progress bar goes in reverse (from 100 to 0) but the userform will not unload at the end.


Sub MoveCells()
Dim objBook As Workbook
Dim objSheet As Worksheet
Dim lngRowSpace As Long
Dim strName As String
Dim lngTimeRow As Long
Dim lngStartRow As Long
Dim lngInteration As Long
Dim strDataSheet As String
Dim boolError As Boolean
Dim counter As Integer
Dim PctDone As Single