Sub Transfert()
Dim chemin$, fichier$, feuille$, tablo, i&, n&
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "classeur_arrivee.xlsm" 'à adapter
feuille = "Feuil1" 'à adapter
If Dir(chemin & fichier) = "" Then MsgBox "'" & fichier & "' est introuvable...": Exit Sub
tablo = [B20:C44] 'matrice plus rapide
For i = 1 To UBound(tablo)
If tablo(i, 1) <> "" Then n = n + 1: tablo(n, 1) = tablo(i, 1): tablo(n, 2) = tablo(i, 2)
Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
With Workbooks.Open(chemin & fichier).Sheets(feuille)
If .FilterMode Then .ShowAllData 'si la feuille est filtrée
.Range("D15:I" & .Rows.Count).Delete xlUp 'RAZ
If n Then
.[D15].Resize(n, 2) = tablo
.[D15].Resize(n, 6).Borders.Weight = xlThin 'bordures sur6 colonnes
End If
.Activate
End With
End Sub