Excel VBA сравнить и выровнять пробелы с незаполненными и сдвинуть вниз

Question

У меня есть таблица, подобная приведенной ниже:

Я хотел бы переместить столбец B & C вниз к следующим непустым ячейкам, как показано ниже

Вы можете мне помочь, пожалуйста? может быть больше, чем столбец B и C

спасибо

Answer 1

Попробуйте

Sub test()
    Dim Ws As Worksheet
    Dim rngDB As Range, rng As Range
    Dim vDB As Variant, vR() As Variant
    Dim i As Long, r As Long
    Dim n As Long, c As Integer, j As Integer

    Set Ws = ActiveSheet
    Set rngDB = Ws.UsedRange
    vDB = rngDB
    r = UBound(vDB, 1)
    c = UBound(vDB, 2)
    ReDim vR(1 To r, 1 To c)
    For i = 1 To r
        vR(i, 1) = vDB(i, 1)
        If vDB(i, 1) = "" Then
            n = n + 1
        Else
            For j = 2 To c
                vR(i, j) = vDB(i - n, j)
            Next j
        End If

    Next i
    'rngDB = vR  '<~~~  Use this to write on the same sheet.
    Sheets.Add
    Range("a1").Resize(r, c) = vR
End Sub