Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim r As Long
  Dim c As Long
  If Target.Column <> 6 Then Exit Sub
  Cancel = True:
  Set c = Worksheets(4).Range("F:F").Find(Target, LookIn:=xlValues)
  If Not c Is Nothing Then
    firstResult = c.Address
    Do
        r = Target.Row + 1: Rows(r).Insert Shift:=xlDown
        Intersect(Worksheets(4).Rows(c.Row), Worksheets(4).Range("F:W")).Copy Destination:=Worksheets(2).Range("F" & "W")  'ïûòàåìñÿ êîïèðîâàòü ïåðåñå÷åíèå ñòðîêè è äèàïàçîíà ëèñòà 4 íà ëèñò 2
       Set c = Worksheets(4).Range("F:F").FindNext(c)
      If c Is Nothing Then Exit Do
    Loop While c.Address <> firstResult
  End If
End Sub

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim r As Long
  Dim c As Range              ' х.з. какое значение
  Dim firstResult As String
  Dim Legends As Worksheet
  If Target.Column <> 6 Then Exit Sub   'если тыкаем не в 6й столбец - выходим
Set Legends = ThisWorkbook.Worksheets("Legends")
Set c = Legends.Range("F:F").Find(Target, LookIn:=xlValues)
  If Not c Is Nothing Then                  ' если "с"  найдено...
    firstResult = c.Address
    Do
        Rows(Target.Row + 1).Insert Shift:=xlDown
        Legends.Range("F" & c.Row & ":W" & c.Row).Copy Range("F" & Target.Row + 1)  'пытаемся копировать пересечение строки и диапазона листа 4 на лист 2
          'надо ещё воткнуть копирование ячеек листа "Нормативы ОР" с 1й по 5ю... ???
        Range("A" & Target.Row & ":E" & Target.Row).Copy Range("A" & Target.Row + 1)
      Set c = Legends.Range("F:F").FindNext(c)
    Loop While c.Address <> firstResult
  End If
End Sub

Set c = Legends.Range("F:F").Find(Target, , xlValues, xlWhole, , xlPrevious)