Repeated data into flat file format

[Paul Simon]

Sorry about the title, but didn\'t know how to say it better.

I have 3 columnns of data spread across a speadsheet like this;

Col 1 2 3 Col 1 2 3 Col 1 2 3 Col 1 2 3
xxxxx xxx xx xxxxx xxx xx xxxxx xxx xx xxxxx xxx xx
xxxxx xxx xx xxxxx xxx xx xxxxx xxx xx xxxxx xxx xx
xxxxx xxx xx xxxxx xxx xx xxxxx xxx xx xxxxx xxx xx
xxxxx xxx xx xxxxx xxx xx xxxxx xxx xx xxxxx xxx xx

What\'s the easiest way to get all of the Column 1,2,3 data
into just 3 columns;

Col 1 2 3
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx
xxxxx xxx xx

I need to do this every day, so I\'m not looking for a simple cut and
paste.

After this has been done, the file used as a linked table in Access.

 

[Max]

Just a quick formulas play to tinker with ..

Assuming source data is in sheet: X, cols A to I (3 sets of 3 cols),
col headers in row1, with data within row2 to a max, say: row10 in each set

In another sheet: Y (say)
With 1 set of headers in A1:C1, put:

In A2:
=OFFSET(X!$A$2,MOD(ROW(A1)-1,10),INT((ROW(A1)-1)/10)*3)

In B2:
=OFFSET(X!$B$2,MOD(ROW(A1)-1,10),INT((ROW(A1)-1)/10)*3)

In C2:
=OFFSET(X!$C$2,MOD(ROW(A1)-1,10),INT((ROW(A1)-1)/10)*3)

Then just select A2:C2, copy down by 30 rows to C31
(3 sets x 10 rows per set = 30 rows)

The above will return the desired stacked results in cols A to C

Adapt to suit. Just change the figure "10" in the formulas in A2:C2 (within
the MOD and INT parts) to your actual max extent per set.

And if required, select cols A to C and freeze the values in Y
via an "in-place": Copy > Paste special > Check "Values" > OK

For easy try-out, just rename your actual source sheet to: X,
then copy n paste the 3 formulas as-is into a new sheet.
Get it working first. Then just restore / rename
the source sheet back to its former name, and
leave it to Excel to auto-update the sheetname in the formulas.

 

[Max]

Oops, Typo:

Assuming source data is in sheet: X, cols A to I (3 sets of 3 cols),
col headers in row1, with data within row2 to a max, say: row10 in each set

2nd line above should read as:

col headers in row1, with data within row2 to a max, say: row11 in each set

(I had assumed a max 10 rows of data per set of 3 cols)

 

[Ken Johnson]

Hi Paul,

Try this macro out on a copy of your data to see if it works the way
you want..

Public Sub NColsTo3Cols()
'Blocks of data are moved into columns A-C
'Each block, except the rightmost block, must have the same number of
rows
'as the first block, which is not moved.
Application.ScreenUpdating = False
Dim iLastRow As Long
iLastRow = Range("A" & Range("A:A").Rows.Count).End(xlUp).Row
Dim iLastColumn As Long
iLastColumn = Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column
Dim rgData As Range
Dim rgDestination As Range
Dim I As Integer
For I = 1 To iLastColumn / 3 - 1
Set rgData = Range(Cells(2, 3 * I + 1), Cells(iLastRow, 3 * I + 3))
Set rgDestination = Range(Cells(I * (iLastRow - 1) + 2, 1), Cells((I +
1) * (iLastRow - 1) + 1, 3))
rgDestination.Value = rgData.Value
rgData.ClearContents
Next I
Range(Cells(1, 4), Cells(1, iLastColumn)).ClearContents
End Sub


Ken Johnson

 

[Ken Johnson]

Hi Paul,

I noticed a line has been broken in the tranfer from me to the group,
which you may or may not know how to fix, so here it is again with the
line properly broke...

Public Sub NColsTo3Cols()
Application.ScreenUpdating = False
Dim iLastRow As Long
iLastRow = Range("A" & Range("A:A").Rows.Count).End(xlUp).Row
Dim iLastColumn As Long
iLastColumn = Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column
Dim rgData As Range
Dim rgDestination As Range
Dim I As Integer
For I = 1 To iLastColumn / 3 - 1
Set rgData = Range(Cells(2, 3 * I + 1), Cells(iLastRow, 3 * I + 3))
Set rgDestination = Range(Cells(I * (iLastRow - 1) + 2, 1), _
Cells((I + 1) * (iLastRow - 1) + 1, 3))
rgDestination.Value = rgData.Value
rgData.ClearContents
Next I
Range(Cells(1, 4), Cells(1, iLastColumn)).ClearContents

End Sub

Ken Johnson