Paste Special to New Cells - White Page layout to Database Table

[truongbach langvan]

I have about >4000 records need to be manipulated into a Data Table.
Each Record have Name, Title, Company, Address, Phone, Email.
Every sheet has different numbers of records that lay out like a White Page.

For example:
Record 1 is from cell A1-A6 with A1 is the Name, A2 is the Title, A3 is the
Company, A4 is the Address, A5 is the Phone, A6 is the Email.
Then record 2 is from A7-A12 with the arrangement similar to record 1
......
Record 12 is from B1-B6
Record 13 is from B7-B12
(12,13 are just examples, they can be different numbers)

I need a Macro that copy all those records and paste into a new sheet with a
set up :
Record 1 is from cell A1-F1 (A1: Name, B1:Title, C1:Company, D1:Address,
E1hone, F1:Email)
Record 2 is from cell A2-F2
and so on.

Currently, I do them manually by copy each record and paste special
(transpose) into the new cell but this will take too long for some thousands
of records.

Anyone has an idea to Macro this so that the process can be much quicker and
simlifier please help. I appreciate a lot.

 

[Joel]

try this code. I names the sheets Sheet1 and Sheet2. change as required.

Sub transposeSheet()

DestRowCount = 1
With Sheets("sheet1")
ColCount = 1
Do While .Cells(1, ColCount) <> ""
RowCount = 1
Do While .Cells(RowCount, ColCount) <> ""
.Range(.Cells(RowCount, ColCount), _
.Cells(RowCount + 5, ColCount)).Copy
Sheets("Sheet2").Range("A" & DestRowCount).PasteSpecial _
Transpose:=True
RowCount = RowCount + 6
DestRowCount = DestRowCount + 1
Loop
ColCount = ColCount + 1
Loop
End With
End Sub