Repeated data into flat file format
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
|