Sub iCopy()
Dim iLastRow As Long
Dim iLR As Long
Dim iLastCol As Integer
Dim rng As Range
Dim j As Integer
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range(Cells(1, 1), Cells(iLastRow, 100))
  iLastCol = rng.Find("*", rng(1, 1), xlValues, , xlByColumns, xlPrevious).Column
      Set rng = Range(Cells(1, 1), Cells(iLastRow, 3))
    For j = 5 To iLastCol
      iLR = Cells(Rows.Count, "A").End(xlUp).Row + 1
        rng.Copy Cells(iLR, "A")
      Range(Cells(1, j), Cells(iLastRow, j)).Cut Cells(iLR, "D")
    Next
End Sub

Sub iCopy()
Dim iLastRow As Long
Dim iLR As Long
Dim iLastCol As Integer
Dim rng As Range
Dim j As Integer
Application.ScreenUpdating = False
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
      Set rng = Range(Cells(2, 1), Cells(iLastRow, "L"))          'неизменная часть
      iLastCol = Cells(1, Columns.Count).End(xlToLeft).Column     'последний столбец
    For j = 14 To iLastCol    'от столбца N и до последнего       'единый столбец - столбец М
'      If WorksheetFunction.CountA(Range(Cells(2, j), Cells(iLastRow, j))) <> 0 Then
       iLR = Cells(Rows.Count, "A").End(xlUp).Row + 1
         rng.Copy Cells(iLR, "A")
         Range(Cells(2, j), Cells(iLastRow, j)).Cut Cells(iLR, "M")
'      End If
    Next
Application.ScreenUpdating = True
End Sub