Добавить вырезать и удалить L oop VBA

Question

У меня проблемы с моими кодами vba.

У меня есть данные в столбцах от «A» до «D». В столбце «F» я скопировал столбец «B» и разделил его функцией «Текст в столбцы». Итак, теперь у меня есть данные из столбцов «F» до максимального столбца «I». Но больше половины ячеек по-прежнему пусты. Я хочу написать al oop, который будет go проходить через каждую ячейку, и если он не пустой, вырезать эту ячейку и добавить ее в столбец «B» под данными. Мне пришлось написать здесь код, но он работает не так, как я хочу. Что здесь не так, буду рад любому предложению.

Dim DługośćTabeli As Integer
DługośćTabeli = Cells.Find(What:="*", _
                        After:=Range("A1"), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row

Dim OstatniWiersz As Integer
For OstatniWiersz = DługośćTabeli To 1 Step -1
    If Not Cells(OstatniWiersz, 10) = "" Then
        Range("I" & OstatniWiersz).Cut Range("B" & (OstatniWiersz + 1000))
    End If
Next