Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Critère As String, TbRes(), tb, moins As Byte, i As Long, j As Long
If Not Intersect(Target, Me.[tb_Source[20]]) Is Nothing Then
Critère = Intersect(Target, Me.[tb_Source[20]]).Value
tb = Me.[tb_Source]
j = 0
For i = 1 To UBound(tb)
If tb(i, 20) = Critère Then
j = j + 1: ReDim Preserve TbRes(1 To 6, 1 To j)
TbRes(1, j) = tb(i, 6): TbRes(2, j) = tb(i, 7): TbRes(3, j) = tb(i, 13): TbRes(4, j) = tb(i, 15): TbRes(5, j) = tb(i, 16): TbRes(6, j) = tb(i, 12)
End If
Next i
If j > 0 Then
With Feuil2.[tb_Cible]
moins = 0
If WorksheetFunction.CountA(.Rows(1)) = 1 Then moins = 1
.Offset(.Rows.Count - moins, 1).Resize(j, 6).Value = Application.Transpose(TbRes)
End With
Cancel = True
MsgBox j & " ligne(s) transférée(s)"
End If
End If
End Sub