Delete and shift remaining cells to the top.

I hate it when something simple becomes hard.

See the attachment. All I want to do is delete all of the cells filled with only "d", and shift the remaining cells to the top. This is just a sample; my data set actually has about 250 columns of 12K rows each.

I can do it fine manually, but only for a small subset. The larger the data set, the slower Excel operates, so I'd like to do it via VBA. The process I want to replicate in my macro is done like this: in my Usedrange, do a Find, "d", in "Values". Select all found. Delete. I thought I'd record the process to get the basic code for my macro. The below macro is what came out of the recording.

Sub Macro5()
'
' Macro5 Macro
'

'
    Range("A1:R19").Select
    Range("R19").Activate
    Range("O26").Select
End Sub

So I tried to do it on my won. The macro below is my attempt. For some reason, it only appears to work for one row at a time, and I don't know why. So, any help on this would be highly appreciated.

Sub FirsttryDel_d()
    Dim rng As Range

    Application.ScreenUpdating = False
    For Each rng In ActiveSheet.UsedRange
        If rng.Value = "d" Then
        
        rng.Delete Shift:=xlUp
        End If
    Next rng

    Application.ScreenUpdating = True
 
End Sub