Private Sub Gruppa_Change()

   Dim r As Range

   Dim i%

   Dim tmp As Boolean

   With Me.Tip

       .Clear

       For Each r In Worksheets("Лист1").Range("H2:H100")

       If r.Value = "" Then Exit For

           If r.Offset(0, -1).Value = Me.Gruppa.Value Then

               If .ListCount = 0 Then .AddItem r.Value

                   For i% = 0 To .ListCount - 1

                       If .List(i%, 0) = r.Value Then tmp = 0 Else tmp = 1

                   Next

                   If tmp Then .AddItem r.Value

           End If

       Next

   End With

End Sub

Private Sub Tip_Change()

Dim selectedValue As String

Dim ws As Worksheet

Set ws = Лист1

selectedValue = Tip.Value

Dim cellH As Range

Set cellH = ws.Range("H2:H" & ws.cells(ws.Rows.count, "H").End(xlUp).row).Find(selectedValue)

If Not cellH Is Nothing Then

Opisanie.Value = cellH.Offset(0, 1).Value

End If

End Sub

Private Sub CommandButton1_Click()

Dim lRow&

Application.CutCopyMode = False

   With Worksheets("Свод и Дир")

       .Rows(43).Copy

       .Rows(44).Insert Shift:=xlShiftDown

   End With

   Application.CutCopyMode = True

lRow = Worksheets("Свод и Дир").cells(Rows.count, 1).End(xlUp).row

lRow = IIf(lRow < 44, 44, lRow + 1)

   Worksheets("Свод и Дир").cells(lRow, 2).Value = ДОПУЩЕНИЯ.Opisanie.Value

End Sub

Private Sub UserForm_Activate()

   Dim r As Range

   Dim i%

   Dim tmp As Boolean

   With Me.Gruppa

       .Clear

       For Each r In Worksheets("Лист1").Range("G2:G100")

       If r.Value = "" Then Exit For

       If .ListCount = 0 Then .AddItem r.Value

           For i% = 0 To .ListCount - 1

               If .List(i%, 0) = r.Value Then tmp = 0 Else tmp = 1

           Next

           If tmp Then .AddItem r.Value

       Next

   End With

End Sub