Following on…
try replacing this line:
If rs.EOF = False Then WSP1.Cells(8, 2).CopyFromRecordset rs
with these:
RowsPerSheet = WSP1.Rows.Count - 10 'change this to suit you; it is the max number of rows to copy over to each sheet.
Do While Not rs.EOF
w = rs.GetRows(RowsPerSheet)
v = TransposeDim(w)
'place v in next sheet:
If WSP1HasBeenUsed Then
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Else
Set NewSht = WSP1
WSP1HasBeenUsed = True
End If
NewSht.Cells(8, 2).Resize(UBound(v) + 1, UBound(v, 2) + 1) = v
Loop
which will need to be supported by a function stolen from https://support.microsoft.com/en-gb/kb/246335
Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)
Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
Dim tempArray As Variant
Xupper = UBound(v, 2)
Yupper = UBound(v, 1)
ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = v(Y, X)
Next Y
Next X
TransposeDim = tempArray
End Function
which can be placed below your existing sub.
If you have Option Explicit at the top of your code-module, you may need to add the following at the top of your sub near the other Dim statements:
Dim RowsPerSheet As Long, w, v, WSP1HasBeenUsed As Boolean, NewSht As Worksheet
ps. If you want new sheets to be placed directly after the first sheet (WSP1) you might be able to replace:
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
with:
Set NewSht = Sheets.Add(after:=NewSht)
(untested).