Dim last_row As Integer last_row = Cells(Rows.Count, 1).End(xlUp).Row Range("A1").Select Selection.CurrentRegion.Select Selection.Copy Cells(last_row + 1, 1).PasteSpecial Transpose:=True Rows("1:" & last_row).Delete Shift:=xlUp
Dim last_row As Integer last_row = Cells(Rows.Count, 1).End(xlUp).Row Range("A1").Select Selection.CurrentRegion.Select Selection.Copy Cells(last_row + 1, 1).PasteSpecial Transpose:=True Rows("1:" & last_row).Delete Shift:=xlUp