Autres Copier des lignes fusionnées

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Activate()
Dim P As Range, i&, x$, j&, k%
Application.ScreenUpdating = False
Cells.Delete 'RAZ
Set P = Sheets("Tableau 1").[A2].CurrentRegion
Sheets("Tableau 2").[A1].CurrentRegion.Copy [E1]
With [E1].CurrentRegion
    For i = 2 To .Rows.Count
        x = .Cells(i, 1)
        If x <> "" Then
            For j = 2 To P.Rows.Count
                If P(j, 5) = x Then
                    For k = 1 To 4
                        .Cells(i, k - 4) = P(j, k)
                    Next k
                    Exit For
                End If
            Next j
        End If
    Next i
    .Columns(1).AutoFill .Columns(-3).Resize(, 5), xlFillFormats 'copie les formats
    P.Rows(1).Resize(, 4).Copy .Cells(1, -3) 'en-têtes
    .Columns(0).NumberFormat = "dd/mm/yyyy" 'colonne D
End With
End Sub