Sub Validation_from_Recordset()

Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset

Dim myArray As Variant, i As Long, myStr As String



    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & ThisWorkbook.Path & "\" & "Исход.xls;" & _
      "Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
    
    rst.Open "SELECT F4 FROM [Лист1$]", cnn


myArray = rst.GetRows

For i =  0  To UBound(myArray,  2 )
 If myArray( 0 , i) <> "" Then myStr = myStr & myArray( 0 , i) & ","
Next i
myStr = Left(myStr, Len(myStr) -  1 )


With ThisWorkbook.Sheets("Лист1").Range("H1").Validation
    .Delete
    .Add Type:=xlValidateList, _
         AlertStyle:=xlValidAlertStop, _
         Operator:=xlBetween, _
         Formula1:=myStr
End With

myArray = ""
myStr = ""
rst.Close
cnn.Close

End Sub

Sub Validation_from_Recordset2()

Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset

    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & ThisWorkbook.Path & "\" & "Èñõîä.xls;" & _
      "Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
    
    rst.Open "SELECT F3 FROM [Ëèñò1$]", cnn

With ThisWorkbook.Sheets("Ëèñò2")
    .Range("A1").CopyFromRecordset rst
    ThisWorkbook.Names.Add "ÄèíÄèàïàçîí", _
                           "=" & .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Address(, , , True)
End With
    
rst.Close
cnn.Close

End Sub

Sub Validation_from_Recordset2()

Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset

    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & ThisWorkbook.Path & "\" & "Исход.xls;" & _
      "Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
    
    rst.Open "SELECT F3 FROM [Лист1$]", cnn

With ThisWorkbook.Sheets("Лист2")
    .Range("A1").CopyFromRecordset rst
    ThisWorkbook.Names.Add "ДинДиапазон", _
                           "=" & .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Address(, , , True)
End With
    
rst.Close
cnn.Close

End Sub