Sub Макрос1()
    With ActiveWorkbook.ActiveSheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.UsedRange.Range("D4").Resize(.UsedRange.Rows.Count - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SetRange .UsedRange
        .Sort.Header = xlYes
        .Sort.MatchCase = False
        .Sort.Orientation = xlTopToBottom
        .Sort.SortMethod = xlPinYin
         Range("A1:H3").MergeCells = False
        .Sort.Apply
         Range("A1:H3").Merge (True)
    End With
End Sub

Sub Макрос1()
    With ActiveWorkbook.ActiveSheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.UsedRange.Range("D4").Resize(.UsedRange.Rows.Count - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SetRange .UsedRange
        .Sort.Header = xlYes
        .Sort.MatchCase = False
        .Sort.Orientation = xlTopToBottom
        .Sort.SortMethod = xlPinYin
        .Sort.Apply
    End With
End Sub

Sub Vstavit_formulu1()
    Application.ScreenUpdating = False
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],CHOOSE({1,2},'Средства измерений'!C6,'Средства измерений'!C2),2,0)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],CHOOSE({1,2},'Средства измерений'!C6,'Средства измерений'!C3),2,0)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],CHOOSE({1,2},'Средства измерений'!C6,'Средства измерений'!C4),2,0)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],CHOOSE({1,2},'Средства измерений'!C6,'Средства измерений'!C5),2,0)"
    ActiveCell.Offset(0, -3).Range("A1:D1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.Offset(1, -2).Range("A1").Select
    Application.ScreenUpdating = True
End Sub

Sub macro()
    Dim i As Integer, j As Integer, index As Integer
    i = 0
    j = 0
    index = 1
    
    While Worksheets("Месяцы").Cells(1 + i, 1) <> 0
        For j = 1 To Sheets.Count Step 1
            If Sheets(j).Name <> Worksheets("Месяцы").Cells(1 + i, 1) Then
                index = index + 1
            ElseIf Sheets(j).Name = Worksheets("Месяцы").Cells(1 + i, 1) Then
                j = Sheets.Count
            End If
        Next j
        'MsgBox index
        'MsgBox Sheets.Count + 1
        If index = Sheets.Count + 1 Then
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Worksheets("Месяцы").Cells(1 + i, 1)
        End If
        index = 1
        i = i + 1
    Wend
    Worksheets("Месяцы").Activate
End Sub

Private Sub ComboBox2_Enter()

    txtArr = wsh.Range(wsh.Cells(2, 1), wsh.Cells(m, 2)).Value

    txtArr = wsh.Range(wsh.Cells(2, 3), wsh.Cells(m, 4)).Value

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
   If Not Intersect(Target, [B34,B35,B36,B37,B38,B39,B40,B41,B42,B43,B44,B45,B46,B47,B48]) Is Nothing Then
   Поиск_приборов_одна.Show
   End If
End Sub