Excel loop copy a range in sheet 1 and paste to sheet 2 - vba

Question

I'm not sure how the logic of loop works.
I have a table at sheet 1 with 105 rows and 120 columns.
I want to do a loop, start with cell J6, copy a range of 100 rows and 16 columns. And transpose and paste at sheet 2 (B1:CW16). Then start with cell K6, copy another range of 100 rows and 16 columns and transpose and paste at sheet 2(B19:CW34). Then start with cell L6 (another 100 rows and 16 columns)and paste at sheet 2. (paste at every 18 rows in sheet 2)
I searched online and have the following code:
Sub transpose()
Dim ColNum As Long
Dim i as long
For ColNum = 10 To 108
LR = Range("B" & Rows.Count).End(xlUp).Row
Sheet1.Activate
Range((Cells(6, ColNum)), (Cells(105, ColNum + 15))).copy
'Transpose
Sheet2.Activate
For i = 1 To LR Step 18
Cells(i, 2).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False, transpose:=True
Next i
Next ColNum
End Sub
This code does not give me what I want. this code copy a range in sheet 1 and paste multiple times in sheet 2 and then copy a second range in sheet 1 and replace everything in sheet 2. How do I modify the code so that I can copy the first range in sheet1, paste to sheet 2 range B1:CW16, then copy the second range in sheet1, and paste to sheet 2 range B19:CW34. (a step of 18 rows at sheet 2)?

Answer 1

Not the most elegant but this should help. I have tried to make the terms as descriptive as possible to help you understand what is going on at each stage.
You can modify these to transpose different numbers of columns and rows from different ranges in the source sheet.
Where to copy from: startCell
When to end copying from: endCell
Where to start pasting to: targetStartCell
How much to transpose: copyRowSize , copyColumnSize
Steps to govern next row destination for transpose: rowStep
Option Explicit
Public Sub TransposeToOtherSheet()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1") 'change as appropriate
Const numberOfRows As Long = 105
Const numberOfColumns As Long = 120
Const copyRowSize As Long = 100
Const copyColumnSize As Long = 16
Const rowStep As Long = 18
Dim startCell As Range
Dim endCell As Range
Set startCell = ws.Range("J6")
Set endCell = ws.Range("DY6")
Dim targetSheet As Worksheet
Dim targetStartCell As Range
Dim targetRow As Long
Dim targetColumn As Long
Set targetSheet = wb.Worksheets("Sheet2") 'change as appropriate
Set targetStartCell = targetSheet.Range("A1")
targetRow = targetStartCell.Row
targetColumn = targetStartCell.Column
Dim currentColumn As Long
Dim headerRow As Long
headerRow = startCell.Row
Dim targetRowCounter As Long
For currentColumn = startCell.Column To endCell.Column
If targetRowCounter = 0 Then
targetStartCell.Resize(copyColumnSize, copyRowSize) = Application.WorksheetFunction.Transpose(ws.Cells(headerRow, currentColumn).Resize(copyRowSize, copyColumnSize))
Else
' Debug.Print "destination range " & targetSheet.Cells((targetRowCounter * rowStep) + targetRow, targetColumn).Resize(copyColumnSize, copyRowSize).Address
targetSheet.Cells((targetRowCounter * rowStep) + targetRow, targetColumn).Resize(copyColumnSize, copyRowSize) = Application.WorksheetFunction.Transpose(ws.Cells(headerRow, currentColumn).Resize(copyRowSize, copyColumnSize))
End If
targetRowCounter = targetRowCounter + 1
Next currentColumn
End Sub