Excel VBA VBAマクロ

VBAを使ってExcelの項目（カテゴリーなど）を下にコピーしたい

Excelで資料やデータを整理している時に、カテゴリなどの項目を下にコピーしたいこと、ありませんか？セルの結合をしても、きれいな表にはなるのですが、フィルターを使いたいときに、ちょっといまいち･･･でも、手動でコピーするのは、大変。
というときに使えるのが、こちらのソースコードになります。

選択しているセルの列の下方向へ空のセルにコピーします。さらに、見た目でコピーされたことがわからないように、文字の色も変更しています。

最初は何もないセル

このプログラムを使った結果

選択範囲を取り消すと、わかりません。。

ソースコード

Sub EmptyCellCopy()
    
    ' 変数の宣言
    Dim lngLastY As Long
    Dim lngLoop As Long
    Dim lngDataSetCol As Long
    Dim lngDataStart As Long
    
    ' 変数の初期化
    lngLastY = ActiveSheet.UsedRange.Rows.Count
    lngDataSetCol = ActiveCell.Column
    lngDataStart = ActiveCell.Row
    
    ' データ開始行から最終行まで動かす
    For lngLoop = lngDataStart To lngLastY
        ' セルが空の場合
        If IsEmpty(ActiveSheet.Cells(lngLoop, lngDataSetCol).Value) = True Then
            ' 上のセルの値を代入
            ActiveSheet.Cells(lngLoop, lngDataSetCol).Value = ActiveSheet.Cells(lngLoop - 1, lngDataSetCol).Value
            ' セルのフォントの色を修正する
            ActiveSheet.Cells(lngLoop, lngDataSetCol).Font.ColorIndex = 2
        End If
    Next
    
End Sub

-Excel, VBA, VBAマクロ
-