Sub Importer()
Dim t#, chemin$, fichier$, dercol$, formule$, n&
t = Timer
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Source.xlsx" 'à adapter
dercol = "H" 'dernière colonne à copier
formule = "'" & chemin & "[" & fichier & "]Feuil1'!"
On Error Resume Next
n = ExecuteExcel4Macro("MATCH(""zzz""," & formule & "C4)") 'dernière cellule texte en colonne D
On Error GoTo 0
'---restitution---
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille de destination
If .FilterMode Then .ShowAllData 'si la feuille est filtrée
With .Range("A1:" & dercol & 1).Resize(n)
.FormulaArray = "=" & formule & "A1:" & dercol & n 'formule de liaison matricielle
.Value = .Value 'supprime la formule
.Rows(1) .Offset(n).Resize(Rows.Count - n).ClearContents 'RAZ en dessous
.Sort .Columns(4), Header:=xlYes 'tri pour regrouper et accélérer
.Columns(4).Replace "4GF", "#N/A"
On Error Resume Next
.Columns(4).Offset(1).SpecialCells(xlCellTypeConstants, 3).EntireRow.Delete 'textes et nombres
.Columns(4).Replace "#N/A", "4GF"
.Replace 0, "", xlWhole 'efface les valeurs zéro
End With
With .UsedRange: End With 'actualise les barres de défilement
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \sec"), , "Import"
End Sub