importation données sauf des lignes précises (Code de Job)

Option Explicit

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

Sub Importer()
Dim t#, F As Worksheet, d As Object, derlig1&, tablo, i&, x$, derlig&, P As Range, code, coderest()
t = Timer
Set F = Feuil01 'CodeName de la feuille de destination
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
'---liste sans doublon des concaténations de A B C E F H---
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
derlig1 = F.Cells(F.Rows.Count, 1).End(xlUp).Row
If derlig1 > 7 Then
    tablo = F.Range("A8:H" & derlig1) 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        x = tablo(i, 1) & "#" & tablo(i, 2) & "#" & tablo(i, 3) & "#"
        x = x & tablo(i, 5) & "#" & tablo(i, 6) & "#" & tablo(i, 8)
        d(x) = i 'repérage de la ligne
    Next
End If
F.Range("A8:K" & F.Rows.Count).Delete xlUp 'RAZ
'---copie du tableau source---
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
    '---copie des "OT" et des "Refacturation" de la 2ème feuille---
    With .Parent.Sheets(2).Range("C15:G" & .Rows.Count)
        i = Application.CountIf(.Columns(1), "OT*")
        i = i + Application.CountIf(.Columns(1), "Refacturation*")
        If i Then
            Set P = Intersect(.Cells, .Parent.UsedRange)
            P.UnMerge 'en cas de cellules fusionnées
            P.Columns(2) = "=IF(LEFT(RC[-1],2)=""OT"",1,IF(LEFT(RC[-1],13)=""Refacturation"",2))" 'numérotation
            P.Columns(2) = P.Columns(2).Value 'supprime les formules
            .Sort .Columns(2), xlAscending, Header:=xlNo 'tri
            Union(P.Columns(2).Resize(, 3), P.Columns(6)) = ""
            Set P = .Resize(i, 6)
            P.Columns(5).Resize(, 5).Insert xlToRight 'donne 11 colonnes
            P.Font.Bold = False 'non gras, au cas où...
        End If
    End With
    If i Then P.Copy .Cells(derlig + 1, 1): derlig = derlig + i
    If derlig > 7 Then
        .Range("H8:K" & derlig).NumberFormat = "# ##0.00"  'ou "0.00" ou "# ##0.00 €"
        .Range("H8:K" & derlig).HorizontalAlignment = xlRight
        .Range("H8:K" & derlig).IndentLevel = 1
        .Range("J8:K" & derlig) = .Range("J8:K" & derlig).Value 'supprime les formules
        With .Range("A8:K" & derlig)
            .Interior.ColorIndex = xlNone 'aucune couleur de fond
            .Font.ColorIndex = xlAutomatic 'police sans couleur
            .ClearComments 'supprime les commentaires
            .Copy F.[A8] 'copie tout le reste
        End With
    End If
    .Parent.Close False
    If derlig < 8 Then derlig = 7: GoTo 1
End With
'---suppression des lignes en gras ou contenant 0 en colonne J---
F.[L:L].Insert 'insertion d'une colonne auxiliaire devant la colonne L
With F.Range("L8:L" & derlig)
    .FormulaR1C1 = "=1/OR(Gras(RC1),RC10=0)" '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" ni de 0 en colonne J
    Intersect(.SpecialCells(xlCellTypeConstants, 1).EntireRow, F.[A:L]).Delete xlUp
End With
F.[L:L].Delete 'suppression de la colonne auxiliaire
'---repositionnement des codes colonne L---
If derlig1 > 7 And derlig > 7 Then
    tablo = F.Range("A8:H" & derlig)
    code = F.Range("L8:M" & derlig1) 'au moins 2 éléments
    ReDim coderest(1 To derlig, 1 To 1)
    For i = 1 To UBound(tablo)
        x = tablo(i, 1) & "#" & tablo(i, 2) & "#" & tablo(i, 3) & "#"
        x = x & tablo(i, 5) & "#" & tablo(i, 6) & "#" & tablo(i, 8)
        If d.exists(x) Then coderest(i, 1) = code(d(x), 1)
    Next
    F.Range("L8:L" & derlig) = coderest
End If
'---finale---
F.Range("A8:L" & derlig).Borders.Weight = xlThin 'bordures
F.Range("A8:L" & derlig).Borders(xlInsideHorizontal).LineStyle = xlDot 'bordures
1 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" 'mesure facultative
End Sub