Это решение будет циклически проходить через rangeAreas, копировать содержимое в столбце B этой области, удалять пробелы и, но результаты возвращаются в столбец b, мне требуется столбец Z в качестве вспомогательного столбца
Sub Button1_Click()
Dim RangeArea As Range, x
For Each RangeArea In Columns("A").SpecialCells(xlCellTypeConstants, 1).Areas
x = RangeArea.Rows.Count
RangeArea.Offset(, 1).Copy [z1]
Columns("Z:Z").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
RangeArea.Offset(, 1).Value = Range("Z1:Z" & x).Value
Range("Z:Z").Delete
Next RangeArea
End Sub