How to shift cells from different columns to one in the same order?

Question

excel

Hello. There is a large file, it has three columns. You need to combine them into one, but so that the cells go in the same order. For clarity, below is an example. Thanks in advance for your reply.

Answer 1

Already found a suitable macro:
Sub Macro()
Dim sh As Worksheet
Dim lr As Long, lc As Long, i As Long
'1. Turning off the monitor to speed up the macro.
Application.ScreenUpdating = False
'2. Vba naming the active sheet to refer to the sheet named "sh".
Set sh = ActiveSheet
'3. Checking that there are no hidden lines, because some actions don't work if rows are hidden.
If sh.Rows.SpecialCells(xlCellTypeVisible).Rows.Count <> sh.Rows.Count Then
Application.ScreenUpdating = True
MsgBox "Display all rows so there are no unexpected situations.", vbExclamation
Exit Sub
End If
'4. Checking that there are no hidden columns, because some actions don't work if columns are hidden.
If sh.Columns.SpecialCells(xlCellTypeVisible).Columns.Count <> sh.Columns.Count Then
Application.ScreenUpdating = True
MsgBox "Display all columns so there are no unexpected situations.", vbExclamation
Exit Sub
End If
'5. Finding the last row with data in column A.
lr = sh.Columns("A").Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
For i = lr To 1 Step -1
'6. Finding the last column in the current row.
lc = sh.Rows(i).Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False). Column
'7. If there is only one cell with data, then no action needs to be taken.
If lc = 1 Then
GoTo metka_NextRow
End If
'8. Insert the desired number of empty lines.
sh.Rows(i + 1).Resize(lc - 1).Insert
'9. Copy data from row to column.
sh.Cells(i, "A").Resize(lc).Value = WorksheetFunction.Transpose(sh.Cells(i, "A").Resize(, lc).Value)
'10. Cleaning up a line.
sh.Cells(i, "B").Resize(, lc - 1).
metka_NextRow:
Next i
'11. Turning on the monitor.
Application.ScreenUpdating = True
EndSub