Ttrying to copy large data in sheet1 but only 65536 records get copied

Hi guys

I am writing the following code to copy data from Access database to Excel. the total number of records that get copied are 90000 so .It gives me error message .

but is there anyway to get it done. I mean writing the piece of code to check if sheet1 is full then move to sheet 2 and then sheet3 and so on until all data gets copied.

Private Sub CommandButton1_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim r As Long
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=J:\Policies.mdb;"


Set rs = CreateObject("ADODB.Recordset")

      
      strsql = "select Policy_No from  Policy_Nos where Policy_Type='FSL'"
      
      rs.Open strsql, cn
            
        
      Set ws = ThisWorkbook.Worksheets("FSL")
        
        
        For colIndex = 0 To rs.FIELDS.Count - 1
        ws.Cells(1, colIndex + 1) = rs.FIELDS(colIndex).Name
        Next
     
     ws.Cells(2, 1).CopyFromRecordset rs
     ws.UsedRange.Columns.AutoFit
      rs.Close
      
      
      
End Sub