How to fasten export to excel

Question

 

Public Sub excelexport(ByVal 
lvexcel As ListView)

Dim mcd As New SaveFileDialog

mcd.ShowDialog()

If mcd.FileName = "" Then

Exit Sub

End If

Dim exapp As Object

Dim wsheet As Object

Dim wbook As Object

exapp = CreateObject("excel.application")

wbook = exapp.Workbooks.Add

wsheet = wbook.worksheets(1)

Dim i, j, mrow As Integer

mrow = 1

For i = 0 To 
lvexcel.Columns.Count - 1

If lvexcel.Columns(i).Width > 0 
Then

wsheet.Cells(mrow, i + 1) = lvexcel.Columns(i).Text

wsheet.Cells(mrow, i + 1).Font.bold = True

End If

Next i

For i = 0 To 
lvexcel.Items.Count - 1

mrow = mrow + 1

For j = 0 To 
lvexcel.Items(i).SubItems.Count - 1

If lvexcel.Columns(j).Width > 0 
Then

wsheet.Cells(mrow, j + 1) = lvexcel.Items(i).SubItems(j).Text

End If

Next j

Next i

wsheet.Columns.EntireColumn.AutoFit()

wsheet.Rows.EntireRow.AutoFit()

If mcd.FileName.Contains(".xls") Then

wsheet.SaveAs(mcd.FileName)

wbook.Close()

Else

wsheet.SaveAs(mcd.FileName & ".xls")

wbook.Close()

End If

exapp = Nothing

MsgBox("Report 
Completed")

End Sub

I written above code to export ListView data to Excel file.
It is working fine. but, when listview having more data(morethan 5000 rows) than it is getting slow to export.
is their any code to fasten this export to excel.