Set rsFlt = New ADODB.Recordset
   rsFlt.Fields.Append "Вкладка", adChar,  3 
   rsFlt.Fields.Append "Галка", adBoolean
   rsFlt.Fields.Append "Параметр", adVarChar,  20 
   rsFlt.Fields.Append "Условие", adInteger, , adFldIsNullable
   rsFlt.Fields.Append "Значение1", adDouble, , adFldIsNullable
   rsFlt.Fields.Append "Значение2", adDouble, , adFldIsNullable
   rsFlt.Open , , adOpenStatic, adLockBatchOptimistic
'Данные по Мехдобыче
   rsFlt.AddNew Array("Вкладка", "Условие", "Галка", "Параметр"), Array("НФРаб", Null, False, "Qж")
   rsFlt.AddNew Array("Вкладка", "Условие", "Галка", "Параметр"), Array("ДобРаб", Null, False, "Qн")
   rsFlt.AddNew Array("Вкладка", "Условие", "Галка", "Параметр"), Array("ДобРаб", Null, False, "%H2O")
   rsFlt.AddNew Array("Вкладка", "Условие", "Галка", "Параметр"), Array("ДобРаб", Null, False, "Dштуцера")

rsFlt.Fields.Append "Вкладка", adChar,  3 

do until rs.Eof
 rsFlt.AddNew Array("Вкладка", "Условие", "Галка", "Параметр"), _
  Array(rs.Fields("Вкладка").Value, rs.Fields("Условие").Value, rs.Fields("Галка").Value, rs.Fields("Параметр").Value)
 rsflt.Update
 rs.Movenext
loop

Private Sub btnСорт_Click()
   Dim t1 As Date, t2 As Date
   t1 = Now
   rsx.Sort = "ДАТА"
   t2 = Now
   lblСорт = Format((t2 - t1), "hh:mm:ss")
End Sub

Private Sub btnСтарт_Click()
   Dim t1 As Date, t2 As Date, t3 As Date
   If Not rsx Is Nothing Then Set rsx = Nothing
   Call Создать_rsx
   If rs.State = adStateOpen Then rs.Close
   Screen.MousePointer = ccHourglass
   DoEvents
   t1 = Now
   rs.Open
   t2 = Now
   Do Until rs.EOF
      rsx.AddNew 'Array("ИД", "ДАТА", "ТЕКСТ"), Array(rs.Fields(0), rs.Fields(1), rs.Fields(2))
      rsx.Fields( 0 ) = rs.Fields( 0 )
      rsx.Fields( 1 ) = rs.Fields( 1 )
      rsx.Fields( 2 ) = rs.Fields( 2 )
      rs.MoveNext
   Loop
   t3 = Now
   lblКопирование = Format((t2 - t1) *  60 , "hh:mm:ss")
   lblСчитывание = Format((t3 - t2) *  60 , "hh:mm:ss")
   Label2 = "Всего записей  " & rsx.RecordCount
   Screen.MousePointer = ccDefault
End Sub

Private Sub Form_Load()
   DE1.Conn1.Open
   Set rs = New ADODB.Recordset
   rs.Source = s
   rs.CursorLocation = adUseClient
   rs.ActiveConnection = Conn1
   rs.LockType = adLockReadOnly
   rs.CursorType = adOpenStatic
End Sub

Sub Создать_rsx()
   If Not rsx Is Nothing Then Set rsx = Nothing
   Set rsx = New ADODB.Recordset
   rsx.Fields.Append "ИД", adInteger
   rsx.Fields.Append "ДАТА", adDate
   rsx.Fields.Append "ТЕКСТ", adVarChar,  255 , adFldIsNullable
   rsx.Open
End Sub