XL 2010 Copier coller lignes avec condition.

Sub Recup_Valeurs()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long
    Dim i As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("MISE EN PLACE")
    Set f2 = Sheets("MISE EN PLACE POUR FICHE")
    f2.Cells.Clear
    f2.Cells.UnMerge
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    f1.Range("A1:F" & DerLig_f1).Copy f2.Range("A1")
    
    'Suppression des lignes vides
    For i = DerLig_f1 To 2 Step -1
        If f2.Cells(i, "A") = "" Or f2.Cells(i, "A") = 0 Then f2.Rows(i).Delete
    Next i
    
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    'insertion d'une ligne vide nentre différent type de plat
    For i = DerLig_f2 To 2 Step -1
        If f2.Cells(i, "F") <> f2.Cells(i - 1, "F") And f2.Cells(i, "A").Interior.Color <> RGB(255, 0, 0) Then f2.Rows(i).Insert Shift:=xlDown
    Next i
    'Recopie du jour dans chaque séparation des différents types de plat
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    Jour = f2.Cells(i, "A")
    repas = f2.Cells(i, "B")
    For i = 2 To DerLig_f2
        If f2.Cells(i, "A").Interior.Color = RGB(255, 0, 0) Then
            Jour = f2.Cells(i, "A")
            repas = f2.Cells(i, "B")
        End If
        If f2.Cells(i, "A") = "" Then
            Range(f2.Cells(i, "A"), f2.Cells(i, "B")) = Array(Jour, repas)
            With Range(f2.Cells(i, "A"), f2.Cells(i, "B"))
                .Interior.Color = RGB(255, 0, 0)
                .Font.Color = RGB(255, 255, 255)
            End With
            Range(f2.Cells(i, "B"), f2.Cells(i, "C")).MergeCells = True
            With Range(f2.Cells(i, "B"), f2.Cells(i, "C"))
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        End If
    Next i
    
    'insertion d'une ligne vide entre chaque jour et par repas
    For i = DerLig_f2 To 2 Step -1
        If f2.Cells(i, "A").Interior.Color = RGB(255, 0, 0) Then
            f2.Rows(i).Insert Shift:=xlDown
        End If
    Next i
  
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    f2.Range("A1:F" & DerLig_f2).Borders().Weight = xlMedium
    f2.Columns("A:F").EntireColumn.AutoFit

    f2.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub