Recopie contenu de plusieurs colonnes sur un autre tableau selon conditions

Option Explicit

Private Sub Worksheet_Activate()
Dim i As Long, j As Long, k As Long, s As String
Dim vi(), af(), af2 As Long
    Application.ScreenUpdating = False
    vi = Sheets("visite").Cells(1, 1).CurrentRegion.Value
[COLOR="SeaGreen"]'Utilisez la ligne 'A ou les lignes 'B selon que vous souhaitez COMPLETER ou REINITIALISER le tableau.
'________________
'    af = Sheets("affaire").Cells(1, 1).CurrentRegion.Value                                          'A
'________________[/COLOR]
    af = Intersect(Sheets("affaire").Range("$1:$1"), Sheets("affaire").Cells(1, 1).CurrentRegion)   'B
    Sheets("affaire").Cells(1, 1).CurrentRegion.ClearContents                                       [COLOR="SeaGreen"]'B[/COLOR]
[COLOR="SeaGreen"]'________________[/COLOR]
    af2 = 1 + UBound(af, 2)
    ReDim Preserve af(1 To UBound(af, 1), 1 To af2)
    For k = 1 To UBound(af, 1)
        For j = 1 To 5
            Select Case VarType(af(k, j))
                Case vbDate: af(k, af2) = af(k, af2) & "@" & Format(af(k, j), "dd/mm/yy")
                Case Else: af(k, af2) = af(k, af2) & "@" & af(k, j)
            End Select
        Next j
    Next k
    af = Application.transpose(af)
    For k = 1 To UBound(vi, 1)
        If vi(k, 6) = "oui" Then
            s = ""
            For j = 1 To 5
                Select Case VarType(vi(k, j))
                    Case vbDate: s = s & "@" & Format(vi(k, j), "dd/mm/yy")
                    Case Else: s = s & "@" & vi(k, j)
                End Select
            Next j
            For j = 1 To UBound(af, 2)
                If af(af2, j) = s Then Exit For
            Next j
            If j > UBound(af, 2) Then
                ReDim Preserve af(1 To af2, 1 To 1 + UBound(af, 2))
                For i = 1 To 5
                    Select Case VarType(vi(k, i))
                        Case vbDate: af(i, UBound(af, 2)) = Format(vi(k, i), "dd/mm/yy")
                        Case Else: af(i, UBound(af, 2)) = vi(k, i)
                    End Select
                Next i
            End If
        End If
    Next k
    Me.Range(Me.Cells(1, 1), Me.Cells(1, 1).Offset(UBound(af, 2) - 1, UBound(af, 1) - 2)).Value = Application.transpose(af)
    Application.ScreenUpdating = True
End Sub

Me.Range(Me.Cells(1, 1), Me.Cells(1, 1).Offset(UBound(af, 2) - 1, UBound(af, 1) - 2)).Value = Application.transpose(af)

Private Sub Worksheet_Activate()
Dim i As Long, j As Long, k As Long, s As String
Dim vi(), af(), af2 As Long
    Application.ScreenUpdating = False
    vi = Sheets("visite").Cells(1, 1).CurrentRegion.Value
'Utilisez la ligne 'A ou les lignes 'B selon que vous souhaitez COMPLETER ou REINITIALISER le tableau.
'________________
'    af = Sheets("affaire").Cells(1, 1).CurrentRegion.Value                                          'A
'________________
    af = Intersect(Sheets("affaire").Range("$1:$1"), Sheets("affaire").Cells(1, 1).CurrentRegion)   'B
    Sheets("affaire").Cells(1, 1).CurrentRegion.ClearContents                                       'B
'________________
    af2 = 1 + UBound(af, 2)
    ReDim Preserve af(1 To UBound(af, 1), 1 To af2)
    For k = 1 To UBound(af, 1)
        For j = 1 To 5
            Select Case VarType(af(k, j))
                Case vbDate: af(k, af2) = af(k, af2) & "@" & [COLOR="Red"]CDbl(af(k, [B]j[/B]))[/COLOR]
                Case Else: af(k, af2) = af(k, af2) & "@" & af(k, j)
            End Select
        Next j
    Next k
    af = Application.transpose(af)
    For k = 1 To UBound(vi, 1)
        If vi(k, 6) = "oui" Then
            s = ""
            For j = 1 To 5
                Select Case VarType(vi(k, j))
                    Case vbDate: s = s & "@" & [COLOR="Red"]CDbl(vi(k, j))[/COLOR]
                    Case Else: s = s & "@" & vi(k, j)
                End Select
            Next j
            For j = 1 To UBound(af, 2)
                If af(af2, j) = s Then Exit For
            Next j
            If j > UBound(af, 2) Then
                ReDim Preserve af(1 To af2, 1 To 1 + UBound(af, 2))
                For i = 1 To 5
                    Select Case VarType(vi(k, i))
                        Case vbDate: af(i, UBound(af, 2)) = [COLOR="Red"]CDbl(vi(k, i))[/COLOR]
                        Case Else: af(i, UBound(af, 2)) = vi(k, i)
                    End Select
                Next i
            End If
        End If
    Next k
    Me.Range(Me.Cells(1, 1), Me.Cells(1, 1).Offset(UBound(af, 2) - 1, UBound(af, 1) - 2)).Value = Application.transpose(af)
    Application.ScreenUpdating = True
End Sub