Worksheets("Name")

Sheet1 либо Лист1

Worksheets(i)

   Sub Список()
  
    Dim rst As Object
    Dim iconnection As Object
    Dim cnct$, iSelect$
    
    Application.ScreenUpdating = False
    
    Set rst = CreateObject("ADODB.Recordset")
    Set iconnection = CreateObject("ADODB.Connection")
    
    iSelect = "SELECT a.F1 AS col1 FROM [Список_1$] AS a UNION SELECT b.F1 AS col2 FROM [Список_2$] AS b ORDER BY col1"
    cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=NO"""
    iconnection.ConnectionString = cnct
    iconnection.Open
    With rst
        .Open iSelect, iconnection
    End With
    Worksheets("Общий_список").Range("A2").CopyFromRecordset rst
    
    Application.ScreenUpdating = True
    MsgBox "Обработка данных завершена"
End Sub

Private Sub CommandButton1_Click()
    Dim x&, i&, j&, ind&,temp$
    With ActiveCell
        temp = .Offset(, -1)
        For j = 1 To Len(temp)
            x = Asc(Mid(UCase(temp), j, 1))
            ind = ind + x * j + Val(Mid(UCase(temp), j, 1)) * x
        Next j
        ind = ind + Len(.Offset(, -1))
        .Value = ind
    End With
End Sub

Sub test()
    Dim i&, ind&
    Randomize
    For i = 1 To Len("проба")
        ind = ind + Asc(Mid(UCase("проба"), i, 1)) * i
    Next i
    ActiveCell = ind
 End Sub

RND()

Sub test()
    Dim i&, ind&
    Randomize
    For i = 1 To Len("проба")
        ind = ind + Asc(Mid(UCase("проба"), i, 1)) * CDbl(Rnd() * 1000)
    Next i
    ActiveCell = ind
 End Sub

Dim iPath$
iPath = "C:\Users\aidyn.khalimbetov\Desktop\Ежедневник\Новая папка\Менеджеры\" 
wb.SaveAs  iPath & shMain.Range("c" & i) & " .xlsx", FileFormat:=xlOpenXMLWorkbook

c = .Range(Cells(3, 2), Cells(16, 2)).Find("x", LookIn:=xlValues)   

If Not c Is Nothing Then
    MsgBox "!", vbCritical
    Exit Sub
End If

Sub Auto_Open()
'   --------------------------------------------
    Dim olDate#, olApp As Object
    Dim olMail As Object, source_file$
'   --------------------------------------------
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(olMailItem)
    source_file = ThisWorkbook.FullName
    olDate = Date + 30
    If Range("sheet2!a1") >= (Date - 3) Then Exit Sub
    With Sheet1
        .AutoFilterMode = False
        .Range("a1:B1").AutoFilter
        .Range("A1:B1").AutoFilter field:=2, Criteria1:="<=" & olDate
    End With
    If Range("sheet2!A2") <= 1 Then Exit Sub
    ThisWorkbook.Save
    With olMail
        .To = "test1@mail.ru"
        .Subject = "Overdue contracts"
        .Body = "Dear All, Please find attached Excel file with contracts to be overdue within 30 days"
        .Attachments.Add source_file
'        .Displey
        .Send
    End With
    Range("Sheet2!a1") = Date
End Sub