Private Sub CheckedBy_Change()

End Sub

Private Sub DocumentName_Click()

End Sub

Private Sub DocumentNumber_Click()

End Sub

Private Sub Label9_Click()

End Sub

Private Sub NContr_Change()

End Sub

Private Sub Organization_Change()

End Sub

Private Sub TextBox20_Change()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns(1)) Is Nothing Then
        Application.EnableEvents = False
Dim iRow As Long
Dim FoundCell As Range
Dim FAdr As String
 With Worksheets("1")
    Set FoundCell = .Columns(1).Find(Target, , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
      FAdr = FoundCell.Address
      iRow = Target.Row
      Do
        Cells(iRow, 2) = .Cells(FoundCell.Row, 2)
        Set FoundCell = .Columns(1).FindNext(FoundCell)
        iRow = iRow + 1
        If FoundCell.Address <> FAdr Then Cells(iRow, 1) = Target
      Loop While FoundCell.Address <> FAdr
     End If
 End With
    End If
    Application.EnableEvents = True
End Sub

Sub disable_keys() 
Application.OnKey "%{F8}", ""
Application.OnKey "%{F11}", ""
End Sub

Set lis = wb.Worksheets(23) - Как сделать что бы не было привязано 

Sub qwe()
Dim wb As Workbook
Dim lis As Worksheet
Dim r As Worksheet
Set wb = ThisWorkbook
Set lis = wb.Worksheets(23)
w = 2
    For Each r In wb.Worksheets
        If Left(r.Name, 4) = "Bina" Then
            q = 7
            i = r.Cells(Rows.Count, 2).End(xlUp).Row
            For n = 7 To i
               If r.Cells(n, 15) > 0 Then
                   lis.Cells(q, w) = r.Cells(n, 2)
                   lis.Cells(q, w + 1) = r.Cells(n, 15)
                   lis.Cells(q, w + 3) = r.Cells(n, 13)
                 
                   q = q + 1

                End If
                End If
            Next n
            w = w + 6
        End If

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A3:D5")) Is Nothing Then
        If Cells(Target.Row, 5).Value = "Çàêðûò" Then Cells(Target.Row, 2).Activate
    End If
End Sub

Range("A8").Select
    ActiveCell.FormulaR1C1

=СУММЕСЛИМН(Пят_Прод!F:F;Пят_Прод!C:C;$B:$B)+СУММЕСЛИМН(Пят_Прод!P:P;Пят_Прод!M:M;$B:$B