Sub Список_зам_дет()
Dim iLastRow As Long, LastRow As Long, i As Long, b As Long, j As Long, p As Long ' присвоение значений
Application.ScreenUpdating = False ' экран
iLastRow = Cells(Rows.Count, 25).End(xlUp).Row ' непонятно зачем подсчет
zav = Worksheets("Замена деталей").Cells(3, 6) ' выбираем завод "НПЗ", "Мономер", "ГХЗ"
Sost = Worksheets("Замена деталей").Cells(7, 6) ' выбираем год замены
If Cells(5, 6) = "ЧРП" Then ' выбор вкладки Преобразовательной техники
Worksheets("ЧРП").Activate
End If
If Cells(5, 6) = "ИБП" Then ' выбор вкладки ИБП
Worksheets("ИБП").Activate
End If
For i = 3 To 5000
If Cells(i, 1) = zav Then
b = i + 1
With Sheets("Замена деталей")
Range(Cells(i, 1), Cells(i, 25)).Copy .Cells(15, 1)
End With
End If
Next
p = 16
For j = b To 5000 ' цикл от 3 до 5000
   If 1 > 2 Then
   With Sheets("Замена деталей")
   End With
   ElseIf Not IsEmpty(Cells(j, 1)) Then Exit For
   ElseIf Not IsEmpty(Cells(j, 2)) Then
   With Sheets("Замена деталей")
   Range(Cells(j, 1), Cells(j, 25)).Copy .Cells(p, 1)
   p = p + 1
   End With
   ElseIf Not IsEmpty(Cells(j, 3)) Then
   With Sheets("Замена деталей")
   Range(Cells(j, 1), Cells(j, 25)).Copy .Cells(p, 1)
   p = p + 1
   End With
   End If
Next
Worksheets("Замена деталей").Activate
For m = 15 To 1500
Dom = Cells(m, 1).Formula + Cells(m, 2).Formula + Cells(m, 3).Formula
If Dom = "" Then Exit For
If Not IsEmpty(Cells(m, 1)) Then
m = m + 1
ElseIf Not IsEmpty(Cells(m, 2)) Then
m = m
ElseIf Cells(m, 11) <> Sost Then
Range(Cells(m, 1), Cells(m, 25)).Select
Selection.Delete
m = m - 1
End If
Next
For k = 16 To 550
Nek = Cells(k, 1).Formula + Cells(k, 3).Formula
Pust = Cells(k, 1).Formula + Cells(k, 2).Formula + Cells(k, 3).Formula
    If Pust = "" Then Exit For
    If Cells(k + 1, 3) = Nek Then
    Range(Cells(k, 1), Cells(k, 25)).Select
    Selection.Delete
    k = k - 1
    End If
Next
Cells(15, 1).Select
Application.ScreenUpdating = True 'экран
End Sub