Du kannst auch - nach Farben filtern oder auch nicht filtern - zum Bleistift:

Option Explicit

Sub MeineFarbeImKlecks()
Dim Rng As Range
   Set Rng = MeinKlecks(ActiveCell)
   'Debug.Print FarbeImKlecks(ActiveCell, Rng).Address
   Call MsgBox(" in der Farbumgebung = " & FarbeImKlecks(ActiveCell, Rng).Address, _
      vbInformation, "meine Farbe")
   
End Sub

Sub FarbklecksUmgebung()
   'Debug.Print MeinKlecks(ActiveCell).Address
   Call MsgBox("Umgebung = " & MeinKlecks(ActiveCell).Address, _
      vbInformation, "farbiger Spaltenbereich")
End Sub

Function FarbeImKlecks(myCell As Range, myArea As Range) As Range
Dim c As Range
   Set FarbeImKlecks = myCell
   For Each c In myArea
      If c.Address <> myCell.Address Then
         If c.Interior.ColorIndex = myCell.Interior.ColorIndex Then _
            Set myCell = Union(c, myCell)
      End If
   Next c
   Set FarbeImKlecks = myCell
End Function

Function MeinKlecks(myCell As Range) As Range
Dim Rng As Range, Flt As Range
Dim x As Long, fst As Long, lst As Long

   Set MeinKlecks = myCell
   Set Rng = ActiveSheet.Columns(myCell.Column)
   fst = Rng.Rows(1).Row
   lst = Rng.Rows(Rng.Rows.Count).Row
   Application.ScreenUpdating = False
   With Rng
      .AutoFilter
      .AutoFilter Field:=1, Operator:=xlFilterNoFill
      Set Flt = .SpecialCells(xlCellTypeVisible)
      .AutoFilter
   End With
   Application.ScreenUpdating = True
   If Not Intersect(Flt, myCell) Is Nothing Then
      Call MsgBox("Bereich ungültig!", vbCritical, "Abbruch")
      Exit Function
   End If
   For x = Flt.Areas.Count To 1 Step -1
      If Flt.Areas(x).Cells(1).Row < myCell.Row Then
         On Error Resume Next
         fst = Flt.Areas(x).Row + Flt.Areas(x).Rows.Count
         lst = Flt.Areas(x + 1).Row - 1
         Set MeinKlecks = Range(Cells(fst, myCell.Column), Cells(lst, myCell.Column))
         On Error GoTo 0
         Exit For
      End If
   Next x
End Function