Private Sub Worksheet_Change(ByVal Target As Range)
Workbooks.Open Filename:="\\srv-fs-1\usr\sklyuev\Desktop\Книга 2.xlsx" 'Открытие книги с данными
'abook.Worksheets("Освещение").Activate 'Активируем лист в книге
    If Not Intersect(Target, Range("E2")) Is Nothing Then
        Application.EnableEvents = False
Dim i As Long
Dim iLR As Long
Dim iLR_осв As Long
Dim FoundMonth As Range
    iLR = Cells(Rows.Count, "A").End(xlUp).Row + 1
If iLR < 7 Then iLR = 7
Range("A7:A" & iLR).ClearContents   'очищаем столбец А
Range("C7:C" & iLR).ClearContents   'очищаем столбец C
Range("D7:D" & iLR).ClearContents   'очищаем столбец D
Range("F7:F" & iLR).ClearContents   'очищаем столбец F
With Worksheets("Освещение")
' ищем столбец с месяцем
    Set FoundMonth = .Rows(4).Find(Target, , xlValues, xlWhole)
    If Not FoundMonth Is Nothing Then
        iLR_осв = .Cells(.Rows.Count, "B").End(xlUp).Row
        iLR = 7
        For i = 8 To iLR_осв  'цикл по столбцу с найденным месяцем
        If InStr(1, .Cells(i, FoundMonth.Column), "ТР") <> 0 Then
            'Cells(iLR, "A") = .Cells(i - 1, "B") & Chr(10)
            Cells(iLR, "A") = .Cells(i, "B") 'оборудование где есть ТР
            Cells(iLR, "C") = "шт." ' единица измерения
            Cells(iLR, "D").FormulaR1C1 = _
        "=LEFT(RIGHT(IFNA(INDEX('[Книга 2.xlsx]Освещение'!C5:C16,MATCH(RC[-3],'[Книга 2.xlsx]Освещение'!C2,0),MATCH(R2C5,'[Книга 2.xlsx]Освещение'!R4C5:R4C16,0)),""""),3),1)"
            iLR = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
        Next
    End If
End With
    End If
    With Worksheets("Кол-во часов")
    
      For i = 7 To iLR
        Set FoundObject = .Columns(2).Find(Cells(i, "A"), , xlValues, xlWhole)
        If Not FoundObject Is Nothing Then
          Cells(i, "F") = FoundObject.Offset(, 2)
        End If
      Next
   End With

Private Sub Worksheet_Change(ByVal Target 
As Range)
    If Not Intersect(Target, Range("E2")) 
Is Nothing Then
        Application.EnableEvents = False
Dim i As Long
Dim iLR As Long
Dim iLR_осв As Long
Dim FoundMonth As Range
    iLR 
= Cells(Rows.Count, "A").End(xlUp).Row + 1
If iLR < 7 Then iLR = 7
Range("A7:A" & 
iLR).ClearContents   'очищаем столбец А
With Worksheets("Освещение")
' ищем столбец с 
месяцем
    Set FoundMonth = .Rows(4).Find(Target, , xlValues, xlWhole)
    If Not FoundMonth Is Nothing Then
        iLR_осв = .Cells(.Rows.Count, "B").End(xlUp).Row
        iLR = 7
        For i = 8 To iLR_осв  'цикл по столбцу с найденным месяцем
        If InStr(1, .Cells(i, FoundMonth.Column), "ТР") <> 0 Then
            Cells(iLR, "A") = .Cells(i, "B") 'оборудование, где есть ТР
            iLR = 
Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
        Next
    End If
End With
    End If
    Application.EnableEvents = True
End Sub

Option Explicit
Dim oDict
Dim rowLast As Integer

Public Sub rndLitera()
Dim i As Integer, j%, k%
Dim arrKey

With ThisWorkbook.Worksheets("Лист1")

rowLast = .UsedRange.Row + .UsedRange.Rows.Count - 1
Range(.Cells(3, 3), .Cells(rowLast, 10)).ClearContents

Set oDict = CreateObject("Scripting.Dictionary")
'то
For i = 3 To rowLast
Call setDict
j = .Cells(i, 13)
Do While j > 0
k = CInt(Int((oDict.Count * Rnd())))
.Cells(i, oDict.Items()(k) + 2) = "то"
arrKey = oDict.keys
oDict.Remove (arrKey(k))
j = j - 1
Loop
Next i
'тр
For i = 3 To rowLast
Call setDict
j = .Cells(i, 14)
Do While j > 0
k = CInt(Int((oDict.Count * Rnd())))
.Cells(i, oDict.Items()(k) + 2) = "тр"

arrKey = oDict.keys
oDict.Remove (arrKey(k))
j = j - 1
Loop
Next i
Set oDict = Nothing
End With

End Sub

Private Sub setDict()
Dim i As Integer
oDict.RemoveAll
For i = 1 To 8
oDict(i) = i
Next i
End Sub