vb.net - Excel transpose using VB

Question

I am using VB to show large data in excel. They show up in A1:A3000. I am transposing A1:A6 to B1:G1 using this code:

sheet.Range("A1:A6").Copy()
sheet.Range("B1").PasteSpecial(Transpose:=True)

It's working but I'm facing trouble for repeating this process upto A3000. Basically I want to convert 1 column x3000 rows data into 6 columns x 500 rows data i.e the end result should have 500 rows and columns B:G.

Answer 1

Does this work for you?

Sub Test()
  Dim R1 As Long, R2 As Long, C2 As Long
  R2 = 1
  C2 = 2
  For R1 = 1 To ActiveSheet.UsedRange.Rows.Count
    Cells(R2, C2) = Cells(R1, 1)
    If C2 < 7 Then
      C2 = C2 + 1
    Else
      R2 = R2 + 1
      C2 = 2
    End If
  Next R1
End Sub

Answer 2

Please note that the code is in VBA.
Instead of doing copy/paste, it transforms the content of the range (i.e array)

Option Explicit

Sub Tabulate(ByVal src As Range, ByVal splitSize As Integer, _
ByVal destRangeStart As Range)
Dim i As Integer
Dim rangeToCopy As Range
Dim rangeToPasteOver As Range

Set rangeToCopy = src
Set rangeToPasteOver = destRangeStart

Debug.Print Now
Application.ScreenUpdating = False
For i = 1 To src.Cells.Count Step splitSize
'    rangeToCopy.Resize(splitSize).Copy
'    rangeToPasteOver.PasteSpecial Transpose:=True

    rangeToPasteOver.Resize(ColumnSize:=splitSize).Value = _
        Transform2DArray(rangeToCopy.Resize(splitSize).Value)

    Set rangeToCopy = rangeToCopy.Offset(splitSize)
    Set rangeToPasteOver = rangeToPasteOver.Offset(1)
Next
Application.ScreenUpdating = True

Debug.Print Now
End Sub
Function Transform2DArray(ByVal src As Variant) As Variant
Dim returnValue As Variant

Dim rowCtr As Long
Dim colCtr As Long

Dim destColCtr As Long
Dim destRowCtr As Long


Dim lRows As Long
Dim uRows As Long

Dim lCols As Long
Dim uCols As Long

lRows = LBound(src, 1)
uRows = UBound(src, 1)

lCols = LBound(src, 2)
uCols = UBound(src, 2)

ReDim returnValue(lCols To uCols, lRows To uRows)

destRowCtr = lCols

For colCtr = lCols To uCols
    destColCtr = lRows
    For rowCtr = lRows To uRows
        returnValue(destRowCtr, destColCtr) = src(rowCtr, colCtr)
        destColCtr = destColCtr + 1
    Next
    destRowCtr = destRowCtr + 1
Next

Transform2DArray = returnValue
End Function