The following code should do the trick without formulas
Public Sub VBATranspose()
'# declare
Dim xlsSource As Excel.Worksheet
Dim xlsTarget As Excel.Worksheet
Dim varContents As Variant
Dim lngSourceRow As Long
Dim lngTargetRow As Long
Dim lngColumn As Long
'# initialise
lngTargetRow = 0
Set xlsSource = ThisWorkbook.Worksheets("Input Data")
Set xlsTarget = ThisWorkbook.Worksheets("Desire Result")
'# loop for areas on source worksheet
With xlsSource
For lngSourceRow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row Step 18
varContents = .Range(Cells(lngSourceRow, "A").Address, Cells(lngSourceRow + 16, "A").Address).Value
lngTargetRow = lngTargetRow + 1
For lngColumn = 1 To 17
xlsTarget.Cells(lngTargetRow, lngColumn).Value = varContents(lngColumn, 1)
Next lngColumn
Next lngSourceRow
End With
End Sub
Bookmarks