1. Dim cn as ADODB.Connection
2. Dim rs as ADODB.RecordSet

3. cn.Open ConnectionString "..."
4. cn.Close
5. Set cn=Nothing

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim str As Integer
    Dim rng As Range
    Set rng = Range("A1:A3000")
    
    str = ActiveCell.Row
    If Not (Intersect(Target, rng) Is Nothing) And str <> 0 Then
        On Error GoTo error_handler
        ThisWorkbook.Worksheets("Лист1").Cells(str, 3).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=str_Priority
    End If

    error_handler:
End Sub

Dim ctrl as Control 
Dim ctrl2 as Control 
 
For Each ctrl In UserForm.Controls
  If TypeOf ctrl Is MSForms.Frame Then
    For Each ctrl2 In ctrl.Controls
      If TypeOf ctrl Is OptionButton And ctrl.Value = True Then cn = cn + 1
    Next
  End If
Next
 

Form1.Hide=False
Application.Visible=True
Application.DisplayAlerts=False
Windows("MainForm.xlsx").Close
Application.DisplayAlerts=True
Application.Quit
 

Form1.Hide=True
Application.Visible=False 

Form1.Hide=False
Application.Visible=True
Application.DisplayAlerts=False
Windows("MainForm.xlsx").Close
Application.DisplayAlerts=True

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=путь к БД"
cn.Open

With rs
  .CursorType = adOpenStatic
  .LockType = adLockOptimistic
  .Open "SELECT FIO, AGE FROM Table", cn
  .AddNew
  .Fields!AGE.Value = ComboBox1.Value
  .Fields!FIO.Value = ComboBox2.Value
  .Update
  .Close
End With
cn.Close

Set rs = Nothing
Set cn = Nothing

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True 

  Dim wrkBook As Workbook
'Открываю File2
  Set wrkBook = Workbooks.Open("2.xlsm")

'Ищу последнюю строку в File2
  File2_lastrow = wrkBook.Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row

'Копирую данные из File1 в File2
  .Range("A" & File1_lastrow).Resize(1, 24).Copy wrkBook.Sheets("Лист1").Cells(File2_lastrow , 1)

'Сохраняю и закрываю
  wrkBook.Save
  wrkBook.Close
  Set wrkBook = Nothing
 

Dim Conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
    rs.CursorType = adOpenForwardOnly
    rs.LockType = adLockPessimistic
 

Conn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=..\BD.accdb;"

rs.Open "SELECT * FROM Flew", Conn
With rs
    .AddNew

 

DateX1 = Format(Worksheets("Лист1" )  .Range("N1" )  , "mm/dd/yyyy" )  
DateX2 = Format(Worksheets("Лист2" )  .Range("N2" )  , "mm/dd/yyyy" )  

Conn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
  "Data Source=...BD.accdb;"

rs.Open Source:="SELECT Date1,Day_of_week FROM Flow WHERE Date1 =  '" & "#" & DateX1 & "#" & "' ", ActiveConnection:=Conn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic

    Dim a(), b(), i&
    Dim kr As Integer
 
    With CreateObject("Scripting.Dictionary")
       'заполняем словарь
        a = Sheets(2).[a1].CurrentRegion.Value
        For i = 1 To UBound(a): .Item(a(i, 2)) = i: Next
        
        b = Sheets(1).[a1].CurrentRegion.Value
        For i = 2 To UBound(b)
         kr = Mid(b(i, 1), 2, 3)
         If .exists(kr) Then Worksheets("Данные").Cells(i, 2) = Worksheets("коды").Cells(.Item(kr), 1)
          
        Next
    End With