Macro copier coller colonnes suivant la couleur de l'entête

Public Sub CoJaunes()
Dim B As Object 'déclare la variable B (Onglet Base)
Dim I As Object 'déclare la variable I (Onglet Import)
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim J As Integer 'déclare la variable J (incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante
Set B = ActiveWorkbook.Sheets("Base") 'définit l'onglet B (génère une erreur si l'onglet "Base" n'existe pas)
Set I = ActiveWorkbook.Sheets("Import") 'définit l'onglet I (génère une erreur si l'onglet "Import" n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    MsgBox "Le classeur actif ne contient pas d'onglet nommé [Base] ou [Import]. Impossible d'éxécuter la macro !" 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
DC = B.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DC de la ligne 1 de l'onglet B
For J = 1 To DC 'boucle de 1 à DC
    If B.Cells(1, J).Interior.ColorIndex = 6 Then 'condition : si la couleur du fond de la cellule est jaune
        'définit la cellule de destination DEST
        Set DEST = IIf(I.Range("A1").Value = "", I.Range("A1"), I.Cells(1,  Application.Columns.Count).End(xlToLeft).Offset(0, 1))
        B.Columns(J).Copy DEST 'copie la colonne et la colle dans DEST
    End If 'fin de la condition
Next J 'prochaine colonne de la boucle
End Sub

Set DEST = IIf(I.Range("A1").Value = "", I.Range("A1"), I.Cells(1, Application.Columns.Count).End(xlToLeft).Offset(0, 1))
B.Columns(J).Copy 'copie la colonne J
DEST.PasteSpecial (xlPasteFormats) 'colle dans DEST les formats
DEST.PasteSpecial (xlPasteValues) 'colle dans DEST les valeurs
Application.CutCopyMode = False 'supprime le clognotement des cellules copiées