XL 2013 (Résolu par JOB) importation des données sauf les lignes avec cellules en GRAS

Sub a()
With Application.ReplaceFormat.Interior
       .PatternColorIndex = xlAutomatic
       .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
End With
Selection.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, SearchFormat:=True, ReplaceFormat:=True
Range("A8:K601").AutoFilter Field:=1, Criteria1:=RGB(252, 228, 214), Operator:=xlFilterCellColor
End Sub

Function Gras(c As Range) As Boolean
Gras = c.Font.Bold
End Function

Sub Importer()
Dim F As Worksheet, derlig&
Set F = Feuil1 'CodeName de la feuille de destination
Application.ScreenUpdating = False
F.Range("A8:L" & F.Rows.Count).Delete xlUp 'RAZ
With Workbooks.Open(ThisWorkbook.Path & "\MATOS.xlsx").Sheets(1) 'feuille source
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
    If derlig >= 8 Then .Range("A8:L" & derlig).Copy F.[A8]
    .Parent.Close False
    If derlig < 8 Then Exit Sub
End With
With F.Range("L8:L" & derlig)
    .FormulaR1C1 = "=1/Gras(RC1)" 'utilise la fonction
    On Error Resume Next 's'il n'y a pas de police "gras"
    .SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
    .Value = ""
End With
With F.UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Function Gras(c As Range) As Boolean
Gras = c.Characters(1, 1).Font.Bold
End Function

Function Gras(c As Range) As Boolean
Gras = c.Characters(1, 1).Font.Bold
End Function

Sub Importer()
Dim t#, F As Worksheet, derlig&
t = Timer
Set F = Feuil1 'CodeName de la feuille de destination
Application.ScreenUpdating = False
F.Range("A8:K" & F.Rows.Count).Delete xlUp 'RAZ
With Workbooks.Open(ThisWorkbook.Path & "\MATOS.xlsx").Sheets(1) 'feuille source
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
    If derlig >= 8 Then .Range("A8:K" & derlig).Copy F.[A8]
    .Parent.Close False
    If derlig < 8 Then Exit Sub
End With
F.[L:L].Insert 'insertion d'une colonne auxiliaire devant la colonne L
With F.Range("L8:L" & derlig)
    .FormulaR1C1 = "=1/Gras(RC1)" 'utilise la fonction
    .Value = .Value 'supprime les formules
    F.Range("A8", .Cells).Sort .Cells, xlDescending, Header:=xlNo 'tri pour accélérer, les "1" sont en bas
    derlig = derlig - Application.Count(.Cells)
    On Error Resume Next 's'il n'y a pas de police "gras"
    Intersect(.SpecialCells(xlCellTypeConstants, 1).EntireRow, F.[A:L]).Delete xlUp
End With
F.[L:L].Delete 'suppression de la colonne auxiliaire
F.Range("B8:L" & derlig).Borders.Weight = xlThin 'bordures
F.Rows(derlig + 1 & ":" & F.Rows.Count).Delete 'RAZ en dessous du tableau
With F.UsedRange: End With 'actualise la barre de défilement verticale
Application.ScreenUpdating = True
MsgBox "Durée " & Format(Timer - t, "0.00 \s"), , "Importation"
End Sub

Private Sub CommandButton1_Click()
Dim t, nlig&, d As Object, i&, rest(), j&
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Paie-Mens.xlsx").Sheets("Feuil1")
  t = .Range("A5:AC" & .Range("F" & .Rows.Count).End(xlUp).Row + 2)
  nlig = UBound(t)
  .Parent.Close False
End With
'---restitution du 1er tableau---
[E:E].Copy [AE1] 'sauvegarde la colonne E (matricules) en colonne auxiliaire AE
Range("A3:AC" & Rows.Count).ClearContents 'RAZ
[A3].Resize(nlig, 29) = t
'---liste des noms du 1er tableau---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  If t(i, 5) <> "" Then d(t(i, 5)) = i 'repère la ligne
Next i
'---création du 2ème tableau (rest)---
t = Range("AD3:AE" & Range("AE" & Rows.Count).End(xlUp).Row + 1)
ReDim rest(1 To nlig, 1 To 1)
For i = 1 To UBound(t)
  If t(i, 2) <> "" And d.Exists(t(i, 2)) Then rest(d(t(i, 2)), 1) = t(i, 1)
Next i
'---restitution du 2ème tableau (rest)---
[[URL='http://ae:af].delete/']AE:AF].Delete[/URL] 'à l'origine il y avait des formules en colonne AF
Range("AD3:AD" & Rows.Count).ClearContents 'RAZ
[AD3].Resize(nlig) = rest
End Sub