visual basic macro needed for excel

[Computer Nerd]

I need a macro that takes the first ten cells, the second ten cells, and the
last ten cells in each row, and transposes them to a COLUMN in sheet 2. The
columns will be organized parallel to each other in sheet 2, but organized
so there are only three columns, and the next row appears in three columns
below the previous row on worksheet 2. Confusing? Here is an
illustration....

SHEET 1

Row
1|aaaa|aaaa|aaaa|aaaa|aaaa|aaaa|aaaa|aaaa|aaaa|aaaa|cccc|cccc|cccc|cccc|cccc
|cccc|cccc|cccc|cccc|cccc|
Row
2|xxxx|xxxx|xxxx|xxxx|xxxx|xxxx|xxxx|xxxx|xxxx|xxxx|yyyy|yyyy|yyyy|yyyy|yyyy
|yyyy|yyyy|yyyy|yyyy|yyyy|


SHEET 2

column 1 column 2
|aaaa| |cccc|
|aaaa| |cccc|
|aaaa| |cccc|
|aaaa| |cccc|
|aaaa| |cccc|
|aaaa| |cccc|
|aaaa| |cccc|
|aaaa| |cccc|
|aaaa| |cccc|
|aaaa| |cccc|
| | | |
|xxxx| |yyyy|
|xxxx| |yyyy|
|xxxx| |yyyy|
|xxxx| |yyyy|
|xxxx| |yyyy|

 

[Paul Corrado]

You can also use a formula instead of a macro.

For the first 10 it would be

=Transpose(A1:J1) array entered (ctrl+shift+enter)

Make sure that you highlight the first 10 cells of the column before you
enter the formula and this will populate the whole range at once.

For the remainder of the information, just adjust your range as needed.

HTH

PC

 

[Computer Nerd]

I appreciate the reply, but unfortunately (I should have said this earlier)
I have 450 rows to do. I'm having trouble getting the logic of that loop
down. Any ideas?

 

[Paul Corrado]

That formula would be a lot of work for 430 rows.

Sorry,

PC

 

[Dave Peterson]

How about this:

Option Explicit
Sub testme()

Dim iRow As Long
Dim iCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim myStep As Long
Dim oRow As Long
Dim oCol As Long

Dim curWks As Worksheet
Dim newWks As Worksheet

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

myStep = 10
oRow = 1
With curWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = FirstRow To LastRow
oCol = 1
For iCol = 1 To .Cells(iRow, .Columns.Count).End(xlToLeft).Column _
Step myStep
.Cells(iRow, iCol).Resize(1, myStep).Copy
newWks.Cells(oRow, oCol).PasteSpecial Transpose:=True
oCol = oCol + 1
Next iCol
oRow = oRow + myStep
Next iRow
End With

End Sub