Sub ЗаполнитьПоЦвету()
  Calculate
  ' Очистмелкую Макрос
 Sheets("ГРАФИК").Select
    Range("AM5:AO14", "AQ5:AQ14").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AM5").Select
    
    ' закрасить Макрос
    Range("AM5:AO14", "AQ5:AQ14").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Range("AM5").Select
    
  ' чистим табл
    Sheets("врем").Select
    Range("Таблица3").Select
    Selection.ClearContents
    Range("Таблица32").Select
    Selection.ClearContents
    Range("E7").Select
    Sheets("ГРАФИК").Select
    Calculate
    ' копируем
    Dim Src As Range, Res As Range
    Dim Color As Long
    Dim r As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set Src = ThisWorkbook.Worksheets("ГРАФИК").Range("AL3:AO14")
    Set Res = ThisWorkbook.Worksheets("врем").Range("E7:H220")
    Color = ThisWorkbook.Worksheets("ГРАФИК").Range("A2").Interior.Color
    
    Res.ClearContents
    
    For i = 3 To Src.Rows.Count
        If Src.Cells(i, 1) = 0 Then
            Exit For
        End If
        For j = 2 To Src.Columns.Count
            If Src.Cells(i, j) <> 0 Then
                If Src.Cells(i, j).Interior.Color = Color Then
                    r = r + 1
                    Res.Cells(r, 1) = Src.Cells(i, 1)
                    Res.Cells(r, 2) = Src.Cells(2, j)
                    Res.Cells(r, 3) = Src.Cells(1, j)
                    Res.Cells(r, 4) = Src.Cells(i, j)
                End If
            End If
        Next j
    Next i
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    
 ' копируем 2 столбик
 Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set Src = ThisWorkbook.Worksheets("ГРАФИК").Range("AP3:AQ14")
    Set Res = ThisWorkbook.Worksheets("врем").Range("L7:O220")
    Color = ThisWorkbook.Worksheets("ГРАФИК").Range("A2").Interior.Color
    
    Res.ClearContents
    
    For i = 3 To Src.Rows.Count
        If Src.Cells(i, 1) = 0 Then
            Exit For
        End If
        For j = 2 To Src.Columns.Count
            If Src.Cells(i, j) <> 0 Then
                If Src.Cells(i, j).Interior.Color = Color Then
                   r = r + 1
                    Res.Cells(r, 1) = Src.Cells(i, 1)
                    Res.Cells(r, 2) = Src.Cells(2, j)
                    Res.Cells(r, 3) = Src.Cells(1, j)
                    Res.Cells(r, 4) = Src.Cells(i, j)
                End If
            End If
        Next j
    Next i
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub