VBA code not running with big amount of data in excel - excel

Question

I am having a hard time trying to figure out why the code is not running when I try to use it for a big set of data. I need to do a transposition per batches of 144000 data points from rows to columns.
I did a trial for working with a VBA code that allows me to do a transposition per batches of data from 2RX5C to 5RX2C. the code works:
Sub Macro1()
End Sub
Sub transpose()
'
' transpose Macro
'
' Keyboard Shortcut: Ctrl+Shift+T
'
Range("A1:E2").Select
ActiveCell.Range("A1:E2").Select
Selection.Copy
ActiveCell.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, transpose:=True
Do Until IsEmpty(ActiveCell)
ActiveCell.Offset(5, -7).Range("A1:E2").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, transpose:=True
Loop
End Sub
However, when I adequate the code for working with 24RX56C to 56RX24C, the code does not run once I include Do until IsEmpty(ActiveCell) and Loop. (It skips all the code between these two)
Sub TRANSPOSE()
'
' TRANSPOSE Macro
'
' Keyboard Shortcut: Ctrl+Shift+T
'
Range("B2:BE25").Select
ActiveCell.Range("A1:BD24").Select
Selection.Copy
ActiveCell.Offset(0, 60).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, TRANSPOSE:=True
Do until IsEmpty(ActiveCell)
ActiveWindow.SmallScroll Down:=57
ActiveCell.Offset(56, -60).Range("A1:BD24").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, 60).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, TRANSPOSE:=True
Loop
End Sub
I am stuck for a month now and I would appreciate any help.

Answer 1

Macro recorder is not much use for something like this - you need to read up a little on how to set and manipulate Range variables, in addition to avoiding Select/Activate
Sub TRANSPOSE()
Dim rng As Range, rngP As Range
Set rng = ActiveSheet.Range("B2:BE25") 'source range
Set rngP = rng.Cells(1).Offset(0, rng.Columns.Count + 1) 'destination range
Do While Len(rng.Cells(1).Value) > 0
rng.Copy
rngP.PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, TRANSPOSE:=True
'offset source and destination ranges
Set rng = rng.Offset(rng.Rows.Count, 0)
Set rngP = rngP.Offset(rng.Columns.Count, 0)
Loop
End Sub