Dim s As Long
s = Cells(Rows.Count, 7).End(xlUp).Row + 1

Private Sub  ListBox1_Click() 
 ListBox2.Value = ListBox1.Value 
 End Sub
 

Public iMassiv 

Private Sub ComboBox1_Change()
On Error Resume Next
 
ListBox1.Clear 
    If Len(ComboBox1.Value) = 0 Then Exit Sub
With ListBox1
    For i = 1 To UBound(iMassiv)
        If UCase(iMassiv(i, 1)) Like "*" & UCase(ComboBox1) & "*" Then
            .AddItem ""
            .List(x) = iMassiv(i, 1)
            x = x + 1
        End If
    Next
End With
End Sub

Private Sub UserForm_Initialize()
iMassiv = Worksheets("Лист1").Range(Cells(2, 2), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 2)).Value
ComboBox1.List = iMassiv
End Sub
 

Sub Mover2()
Dim owbk1 As Workbook
Set owbk1 = ActiveWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim owbk As Workbook
Set owbk = Workbooks.Open("C:\Users\ADM\Dropbox\заявки\Zsetup.xlsm")
owbk1.ActiveSheet.Copy Before:=Workbooks("Zsetup.xlsm").Sheets(1)
Application.ScreenUpdating = True
End Sub
          

Private Sub ComboBox5_Change()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If ComboBox5.Value = "" Then
TextBox11.Value = ""
End If
Dim ex As Workbook
Set ex = Workbooks.Open("\\Srv-2\data\ДОГОВОРА\База данных\БД.xlsx")
Windows.Application.ActiveWorkbook.Sheets("ЭКСЮР").Select
TextBox11 = Worksheets("ЭКСЮР").Cells(ComboBox5.ListIndex + 2, 16)
ex.Close SaveChanges:=False
Application.DisplayAlerts = True
end sub

ThisWorkbook.Sheets("test").Copy
ActiveWorkbook.saveas "c:\test.xls" ' сохраняем лист
ActiveWorkbook.close false ' закрываем файл
attach$  = "c:\test.xls"

Dim i as string
i = ListBox1. а дальше куку (((
Label14.Text = i

Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Select
Range("P1:P" & Cells(Rows.Count, 1).End(xlUp).Row).Select

Private Sub CommandButton6_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim oWbk As Workbook
Set oWbk = Workbooks.Open("C:\Users\bd\rs.xlsx")
Windows.Application.ActiveWorkbook.Sheets("today").Select

'НАХОЖДЕНИЕ ПОСЛЕДНЕЙ ЗАПОЛНЕННОЙ СТРОЧКИ 
lLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row + 1
ActiveSheet.Cells(lLastRow, "A").Value = Format(Now, "DD MMMM YYYY")
ActiveSheet.Cells(lLastRow, "B").Value = "'" & Me.TextBox11.Value
ActiveSheet.Cells(lLastRow, "I").Value = "'" & Me.TextBox3.Value

' ПРОБЛЕМА С ДАННОЙ СТРОЧКОЙ  (ЗАГРУЗКА В ЛИСТБОКС)
Me.ListBox1.List = Worksheets("today").Range(Cells(3, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 12)).Value

' ЗАКРЫТИЕ КНИГИ
'Windows.Application.Workbooks("rs.xlsx").Close SaveChanges:=True
oWbk.Close SaveChanges:=True
Application.ScreenUpdating = True
MsgBox ("Расчет добавлен")
End Sub

Private Sub CommandButton1_Click()
On Error Resume Next
TextBox7.Value = Val(Replace(TextBox2.Value, ",", ".")) + Val(Replace(TextBox4.Value, ",", ".")) + Val(Replace(TextBox5.Value, ",", "."))
Dim a, b, i As Double
a = TextBox2.Value
b = TextBox4.Value
TextBox5.Value = (a * 0.18) + (b * 0.18)
End Sub

Private Sub UserForm_Initialize()
iMassiv = Worksheets("zona").Range("A1:A78").Value
ComboBox1.List = iMassiv

Dim oWbk As Workbook
Set oWbk = Workbooks.Open("\\Srv-2\1.xlsx")
'Windows("1.xlsx").Activate
'Workbooks("1.xlsx").Close True
 
   Dim lLastRow As Long
    ' A.
    lLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row + 1
    ActiveSheet.Cells(lLastRow, "A").Value = Me.TextBox25.Value
    ActiveSheet.Cells(lLastRow, "B").Value = Me.TextBox24.Value

Dim sShName As String, sAddress As String, vData
 'Отключаем обновление экрана
 Application.ScreenUpdating = False
 Workbooks.Open "\\Srv-2\1.xlsx"
 sAddress = "A1" 'или одна ячейка - "A1"
 'получаем значение
 vData = Sheets("1"  ;)  .Range(sAddress).Value
 ActiveWorkbook.Close False
 'Записываем данные на активный лист книги,
 'с которой запустили макрос
 If IsArray(vData) Then
 [A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
 Else
 Me.Label1.Caption = vData
 End If
 'Включаем обновление экрана
 Application.ScreenUpdating = True