Afficher lignes par double clic

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error GoTo fin
   If ActiveCell.Column = 2 And ActiveCell.Font.Bold = True Then
     If Not ActiveCell.Offset(1, 0).EntireRow.Hidden Then
        i = 1
        Do While Not ActiveCell.Offset(i, 0).Font.Bold And Not IsEmpty(ActiveCell.Offset(i, 0))
          i = i + 1
        Loop
        ActiveCell.Offset(1, 0).Resize(i - 1).EntireRow.Hidden = True
      Else
        i = 1
        Do While ActiveCell.Offset(i, 0).EntireRow.Hidden
          i = i + 1
        Loop
        ActiveCell.Offset(1, 0).Resize(i - 1).EntireRow.Hidden = False
     End If
     Cancel = True
   End If
fin:
Exit Sub
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If ActiveCell.Column = 2 And ActiveCell.Font.Bold = True Then
     If Not ActiveCell.Offset(1, 0).EntireRow.Hidden Then
        i = 1
        Do While Not ActiveCell.Offset(i, 0).Font.Bold And Not IsEmpty(ActiveCell.Offset(i, 0))
          i = i + 1
        Loop
        If i > 1 Then ActiveCell.Offset(1, 0).Resize(i - 1).EntireRow.Hidden = True
      Else
        i = 1
        Do While ActiveCell.Offset(i, 0).EntireRow.Hidden
          i = i + 1
        Loop
        If i > 1 Then ActiveCell.Offset(1, 0).Resize(i - 1).EntireRow.Hidden = False
     End If
     Cancel = True
   End If
End Sub