Loop

[TexEth]

I need VBA code for the following copy and-paste looping task.
I am using Excel 365.

Problem
The first row is a header row.
Copy a block (range) of data from Sheets1 to Sheets2.
The range to be copied is always 22 rows and 32 columns.
The first block first and last cell: E2, AJ23
Paste special (transpose) on Sheets2.
Always special paste (transpose) on the first empty cell on E column.
Loop through the data until the last block.
The data starts at E2 and ends at AT2839

Thank you!!

 

[Legacy 143009]

Is it AJ or AT?

 

[TexEth]

The last cell with data is AT2839.

Thank you!

 

[TexEth]

I stand corrected. You are right; it is AJ.

 

[Legacy 143009]

This should work:

Sub moveData()
  Application.ScreenUpdating = False
  For i = 2 To 2818 Step 22
    Worksheets("Sheet1").Cells(i, 5).Resize(22, 32).Copy
    Worksheets("Sheet2").Cells(Rows.Count, 5).End(xlUp).Offset(1).PasteSpecial Transpose:=True
  Next
  Application.ScreenUpdating = True
End Sub

 

[TexEth]

Thank you.
I will test the code and get back to you.
Have a great day!!

 

[TexEth]

I need one more VB code.

In Sheets1, each country name is listed on Column A for 22 rows.
Example: Country 1: A2:A23
Country 2: A24: A45
So on.

Task:
Copy and paste country names on Sheets2, on column A, for 32 rows.
Example: Country 1: A2:A33
Country 2: A34: A65
Do this until the last country is copied and pasted the same way.

 

[TexEth]

This should work:

Sub moveData()
  Application.ScreenUpdating = False
  For i = 2 To 2818 Step 22
    Worksheets("Sheet1").Cells(i, 5).Resize(22, 32).Copy
    Worksheets("Sheet2").Cells(Rows.Count, 5).End(xlUp).Offset(1).PasteSpecial Transpose:=True
  Next
  Application.ScreenUpdating = True
End Sub

The code was precise and efficient. Many thanks!!!!!