Exporting multiple test set in a separate excel sheet from ALM to excel using vba

Hi Friends,

I have exported all test set which is present in test lab folder in single excel sheet.

But I want to export each test set in separate excel sheet.Please help me on this.

Thanks Advance!

PFB the code:

Sub connectQC()
Dim tlrow, tlsrno
Dim qcPath As String
Dim isData As Boolean
Dim QCConnection

tlrow = 2
tlsrno = 2
On Error GoTo err
'Create QC Connection Object to connect to QC
Set QCConnection = CreateObject("TDApiOle80.TDConnection")

Dim sUserName, sPassword, sDomain, sProject, sQCUrl
sQCUrl = Worksheets("Input").Range("K10")
sUserName = Worksheets("Input").Range("K11")
sPassword = Worksheets("Input").Range("K12")
sDomain = Worksheets("Input").Range("K13")
sProject = Worksheets("Input").Range("K14")

QCConnection.InitConnectionEx sQCUrl

'Authenticate your user ID and Password
QCConnection.Login sUserName, sPassword
'Quit if QC Authentication fails

If (QCConnection.LoggedIn <> True) Then
MsgBox "QC User Authentication Failed"
End
End If
'Login to your Domain and Project
QCConnection.Connect sDomain, sProject
'Quit if login fails to specified Domain and Project
If (QCConnection.AuthenticationToken = "") Then
MsgBox "QC Project Failed to Connect to " & sProject
QCConnection.Disconnect
End
End If

Set TCFactory = QCConnection.TestFactory
Set TSTreeMngr = QCConnection.TestSetTreeManager
'qcPath = "Root\ECommerce - B2C\Autozone.com\B2C - DIY\Search Enhancement - Part 2\Search Enhancement-New Changes\"
qcPath = Worksheets("Input").Range("K15")

Set TSFolder = TSTreeMngr.NodeByPath(qcPath)
Set TestSetList = TSFolder.FindTestSets("Desktop")

If TestSetList Is Nothing Then
MsgBox "No Test Cases are there in this location"

Else

clearSheet
For Each TSet In TestSetList
'Get TSTestFactory object for each TestSet
Set TSFact = TSet.TSTestFactory

'Get TestCases of selected Test Set
Set TSTestsList = TSFact.NewList("")
For Each TSTest In TSTestsList
With Sheets("Test Case Data")
.Cells(tlrow, 1).Value = TSTest.Field("TS_Name")

.Cells(tlrow, 2).Value = TSTest.Field("TC_STATUS")
tlrow = tlrow + 1

End With
Next
Next
End If

err:
Application.StatusBar = err.Description

End Sub