Want some idea on transposing function

[kenneth1226]

try:

Sub CommandButton1_Click()()
BlockSize = 10    '<<<you can adjust this.
DestRow = 0 'one less that the destination row.
Set SourceSheet = ActiveSheet
Set DestnWB = Workbooks.Open(Filename:="C:\Users\kenneth\Desktop\TEST\OUTPUT.xlsx")
Set DestnSheet = ActiveSheet
With SourceSheet
  lr = .Cells(.Rows.Count, "A").End(xlUp).Row
  For rw = 1 To lr Step BlockSize
    DestRow = DestRow + 1
    SourceSheet.Cells(rw, 1).Resize(Application.Min(lr - rw + 1, BlockSize)).Copy
    DestnSheet.Cells(DestRow, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Skipblanks:=False, Transpose:=True
  Next rw
End With
DestnWB.Close True
Application.CutCopyMode = False
End Sub

It works. Thanks a lot, bro!👏👏