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

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