Dim L As String
L = CStr(main.Range("LineSource"))
Lines.List = lists.Range("" & L & "").Value

Lines.List = lists.Range("П_ЭСП").Value

Sub Tchpok()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wb As Workbook
Set wb = ThisWorkbook

Dim sales As Worksheet
Set sales = wb.Sheets("Продажи")

Dim dz As Worksheet
Set dz = wb.Sheets("ДЗ")

Dim pay As Worksheet
Set pay = wb.Sheets("Оплаты")

Dim i As Long, n As Long, z As Long


i = Application.WorksheetFunction.CountA(sales.Columns(2)) + 5

sales.Range(Cells(8, 1), Cells(i, 1)).FormulaR1C1 = "=IFERROR(INDEX(Оплаты!C1,MATCH(Продажи!RC3,Оплаты!C3,0)),"""")"
    sales.Range(Cells(8, 1), Cells(i, 1)).Copy
    sales.Range(Cells(8, 1), Cells(i, 1)).PasteSpecial xlPasteValues

sales.Range(Cells(8, 17), Cells(i, 17)).FormulaR1C1 = "=IFERROR(INDEX(Менеджер_для_премии,MATCH(RC[-9],Менеджер_в_отчетах,0)),"""")"
    sales.Range(Cells(8, 17), Cells(i, 17)).Copy
    sales.Range(Cells(8, 17), Cells(i, 17)).PasteSpecial xlPasteValues

n = Application.WorksheetFunction.CountA(dz.Columns(1)) + 50

dz.Range(Cells(8, 15), Cells(n, 15)).FormulaR1C1 = "=IFERROR(INDEX(Продажи!C17,MATCH(ДЗ!RC1,Продажи!C3,0)),"""")"
    dz.Range(Cells(8, 15), Cells(n, 15)).Copy
    dz.Range(Cells(8, 15), Cells(n, 15)).PasteSpecial xlPasteValues

dz.Range(Cells(8, 16), Cells(n, 16)).FormulaR1C1 = "=IFERROR(INDEX(Месяц_период,MATCH(RC3,Дата_ДЗ,0)),R[-1]C)"
    dz.Range(Cells(8, 16), Cells(n, 16)).Copy
    dz.Range(Cells(8, 16), Cells(n, 16)).PasteSpecial xlPasteValues

dz.Range(Cells(8, 17), Cells(n, 17)).FormulaR1C1 = "=IFERROR(INDEX(Продажи!C6,MATCH(ДЗ!RC1,Продажи!C3,0)),"""")"
    dz.Range(Cells(8, 17), Cells(n, 17)).Copy
    dz.Range(Cells(8, 17), Cells(n, 17)).PasteSpecial xlPasteValues

z = Application.WorksheetFunction.CountA(pay.Columns(2)) + 50

pay.Range(Cells(7, 17), Cells(z, 17)).FormulaR1C1 = "=IFERROR(INDEX(Месяц_период,MATCH(RC[1],Месяц_период,0)),R[-1]C)"
    pay.Range(Cells(8, 17), Cells(z, 17)).Copy
    pay.Range(Cells(8, 17), Cells(z, 17)).PasteSpecial xlPasteValues
    
Application.ScreenUpdating = True
Application.DisplayAlerts = True
    
End Sub

   
        ' определяем общее число строк со значениями на исходной странице
        Dim rown As Integer
            Sheets("Продажи").Activate
            rown = Application.WorksheetFunction.CountA(Range("A:A")) + 1        
        
        'Первый столбец массива - фиксированный
        Dim ColNumStart As Integer
            ColNumStart = 4
        'Последний столбец массива - подсчитывает число введенных столбцов с данными
        Dim ColNumFinish As Integer
            ColNumFinish = Sheets("Intermed").Range("A3").End(xlToRight).Column
        ' указывает первую строку для подстановки формул
        Dim RowNumStart As Integer
            RowNumStart = rown + 3
        ' указывает последнюю строку для подстановки формул
        Dim RowNumFinish As Integer
            RowNumFinish = rown + 16
            
Do While RowNumStart <= RowNumFinish
    Do While ColNumStart <= ColNumFinish
        Cells(RowNumStart, ColNumStart) = WorksheetFunction.SumIfs(Range(Cells(3, ColNumStart), Cells(rown, ColNumStart)), _
        Range(Cells(3, 3), Cells(rown, 3)), Cells(RowNumStart, 1))
        ColNumStart = ColNumStart + 1
    Loop
    RowNumStart = RowNumStart + 1
Loop

            
        ' указывает последнюю строку для подстановки формул
        Dim RowNumFinish As Integer
            RowNumFinish = rown + 16
        Dim i As Integer


For i = RowNumStart To RowNumFinish
    Do While ColNumStart <= ColNumFinish
        Cells(i, ColNumStart) = WorksheetFunction.SumIfs(Range(Cells(3, ColNumStart), Cells(rown, ColNumStart)), _
        Range(Cells(3, 3), Cells(rown, 3)), Cells(i, 1))
        ColNumStart = ColNumStart + 1
    Loop
    i = i + 1
Next i
    

Private Sub CheckNum_Click()
    
    If Me.TypeList.Text = "" Then
' Если в списке ничего не выбрано (пусто)
        MsgBox "Введите тип"
' Появляется сообщение. После нажатия на ОК курсор перемещается в окно выпадающего списка. 
    Exit Sub        
    End If

    TypeList.Focus

    Dim iType As Integer
    Dim iMatch As Integer
        iType = Application.WorksheetFunction.CountIf(Range("A:A"), TypeList.Value)
        iMatch = Application.WorksheetFunction.Match(TypeList.Value, Range("A:A"))
    
    MsgBox iType & "*" & iMatch

End Sub

Sub try1()

Dim curD As Date
curD = Range("a1").Value

'В А1 стоит формула =ДАТАЗНАЧ(ТЕКСТ(ТДАТА();"ДД.ММ.ГГГГ")). 
'Единственный вариант, когда сравнение дает "Истина". 
'Может ошибаюсь, но меня устраивает пока.

Dim colN As Long
colN = Application.Match(curD, Range(Cells(7, 1), Cells(7, 400)), 0)

Cells(1, 2) = colN

End Sub

' Выбираем область
    Rows("1:150").Select
    
' Копируем
    Selection.Copy
    
' Открываем книгу отдела
    Workbooks.Open Filename:="\\srv\Obmen\_ФОРМЫ\АРХИВ\" & Range("C5").Value & ".xlsx"
    
' Снимаем защиту
    ActiveSheet.Unprotect Password:="*******"
' Вставляем скопированное в первую пустую строку
    Dim emptyRow As Long
    emptyRow = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(emptyRow, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False