try this 
 
Private Sub goThough()
Dim intIndex As Integer, counter As Integer, strwork() As String
Dim itmWork As ListItem
 
With lstBooks
  ReDim strwork(.ListItems.Count, .ColumnHeaders.Count)
  For Each itmWork In .ListItems
        strwork(counter, 0) = itmWork.Text
        For intIndex = 1 To .ColumnHeaders.Count - 1 'Go though headings
           strwork(counter, intIndex) = itmWork.SubItems(intIndex) 'Loop though 
           ' subItems
        Next intIndex
        counter = counter + 1
  Next itmWork
End With
writeXL(strwork)
End Sub
 
Public Sub writeXL(strwork() As String)
Dim I As Integer, J As Integer, R As Integer, C As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add    'Create WorkBook
Set xlSheet = xlBook.Worksheets(1)  'Set WorkSheet to 1
For I = 0 To UBound(strwork, 1)
   For J = 0 To UBound(strwork, 2)
       'Debug.Print strwork(I, J)
       xlSheet.Cells(I + 1, J + 1) = strwork(I, J)
   Next
Next
xlApp.Visible = True
End Sub