【再度】【エクセルVBA】セル内の色を読み取って同じ数値のところに同じ色を塗りつけたい。

こんな感じでどうでしょう。

Const MAX_ROW = 1000

Function is_blank_cell(c)
    is_blank_cell = IsEmpty(c) Or c.value = ""
End Function

Sub set_background_color()
    Dim bgcolor_map
    Set bgcolor_map = CreateObject("Scripting.Dictionary")

    ' A, C, E, G, I 列の背景色を読み取る
    For c = 1 To 9 Step 2   ' A, C, E, G, I
        r = 1
        blank_count = 0
        Do Until blank_count = 20   ' 空白行が20行続いたら打ち切り
            If is_blank_cell(Cells(r, c)) Then
                blank_count = blank_count + 1
            Else
                v = Cells(r, c).value
                bgcolor = Cells(r, c).Interior.Color
                If Not bgcolor_map.Exists(v) Then
                    bgcolor_map.Add v, bgcolor
                End If
                blank_count = 0
            End If
            DoEvents
            r = r + 1
            If r > MAX_ROW Then     ' 念のため
                Exit Do
            End If
        Loop
    Next

    ' K～M 列に背景色を設定する
    For c = 11 To 13    ' K - M
        r = 1
        blank_count = 0
        Do Until blank_count = 20   ' 空白行が20行続いたら打ち切り
            v = Cells(r, c).value
            If bgcolor_map.Exists(v) Then
                Cells(r, c).Interior.Color = bgcolor_map.Item(v)
            End If
            If is_blank_cell(Cells(r, c)) Then
                blank_count = blank_count + 1
            Else
                blank_count = 0
            End If
            DoEvents
            r = r + 1
            If r > MAX_ROW Then     ' 念のため
                Exit Do
            End If
        Loop
    Next
End Sub

K～M 列の方は空白が20行出てくるまで、とするまでもないような気もするのですが、質問通り空白が20行出てくるまで続ける、というふうにしています。