Sub Macros1()
Dim lastRow As Long, c As Range
Application.ScreenUpdating = False

Sheets("Лист2").Range("A:A").ClearContents

For Each c In Range(Cells(1, 13), Cells(Rows.Count, 23).End(xlUp)).Columns
  c.Copy
  With Sheets("Лист2")
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    If Not IsEmpty(.Cells(lastRow, 1)) Then lastRow = lastRow + 1
    .Cells(lastRow, 1).PasteSpecial xlPasteValues
  End With
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Sub Macros1()
Dim i As Long, iLastColumn As Long, iLastRow As Long, lastRow As Long
iLastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
   With Sheets("Лист2")
      lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
      For i = 13 To 23
         iLastRow = Cells(Rows.Count, i).End(xlUp).Row
         If lastRow = 1 Then
            Range(Cells(1, i), Cells(iLastRow, i)).Copy .Cells(lastRow, 1)
         Else
            Range(Cells(1, i), Cells(iLastRow, i)).Copy .Cells(lastRow + 1, 1)
         End If
         lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
      Next
   End With
End Sub