Ne pas coller le cellules masquées

[COLOR="DarkSlateGray"]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i&, j&, tf As Boolean
   Application.ScreenUpdating = False
   If Target.Column = 1 Then
      Cancel = True
      Cells.EntireRow.Hidden = False
      Cells.EntireColumn.Hidden = False
   End If
   If Target.Row > 4 And Target.Column = 1 And Not IsEmpty(Target) Then
      With Range(Range("B5"), ActiveCell.SpecialCells(xlLastCell))
         For j = 1 To .Columns.Count
            If IsEmpty(Cells(Target.Row, .Columns(j).Column)) Then Columns(.Columns(j).Column).EntireColumn.Hidden = True
         Next j
         For i = 1 To .Rows.Count
            tf = True
            For j = 1 To .Columns.Count
               If Columns(.Columns(j).Column).EntireColumn.Hidden = False Then tf = tf And IsEmpty(.Cells(i, j))
            Next j
            If tf Then .Rows(i).EntireRow.Hidden = True
         Next i
      End With
   End If
   [B]With Sheets("Feuil2")
      .Cells.Clear
      Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("A1")
      .Range("A1") = Target.Value
   End With[/B]
   Application.ScreenUpdating = True
End Sub[/COLOR]