Help with transferring data in one column to multiple columns.
 

I have a list of data that ranges from one cell in column A to over 400 cells
(this can change as well) in column A.

At the moment I have to manually cut and paste the first 50 cell from column
A to Column B, then manually cut and paste the next 50 from column A to
column C, then the next 50 into column D and so on.

The above should be flexible where I can vary the number of cells to be cut
and pasted.

Is there a way that the above can be automated?

Any help offered would be appreciated.

--
Thank U and Regards

Ann

Help with transferring data in one column to multiple columns.
 

This code should do it for you - goes into a regular code module. Cut and
paste.
Use [Alt]+[F11] to open the VB Editor. When you get there, from it's menu
choose Insert | Module. Paste this code into the module and close the VB
Editor. To do the work, use Tools | Macro | Macros and select and run the
MoveGroups macro.

Sub MoveGroups()
'asks user for # of cells
'from col. A to move into
'other columns. Each group
'will be moved into individual
'columns beginning with B
Dim ColPointer As Long
Dim TopRow As Long
Dim CellsToMove As Long
Dim LastRowWithData As Long
Dim sourceRng As Range
Dim destRng As Range

CellsToMove = InputBox$("How many rows in a group" _
& " from column A?", "Rows in a Group", 0)
If CellsToMove < 1 Then
Exit Sub ' no work to do
End If
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
LastRowWithData = _
Range("A" & Rows.Count).End(xlUp).Row
Else
' in Excel 2007 (or later)
LastRowWithData = _
Range("A" & Rows.CountLarge).End(xlUp).Row
End If

ColPointer = 1 ' initialize
TopRow = 1 ' initialize
Do Until TopRow LastRowWithData
Set sourceRng = _
Range("A" & TopRow & ":" _
& Range("A" & TopRow).Offset _
(CellsToMove - 1, 0).Address)
Set destRng = _
Range(Range("A1").Offset(0, ColPointer).Address & _
":" & Range("A1").Offset(CellsToMove - 1, _
ColPointer).Address)
destRng.Value = sourceRng.Value
sourceRng.Clear
' update pointers
TopRow = TopRow + CellsToMove
ColPointer = ColPointer + 1
Loop
End Sub


"Ann" wrote:

I have a list of data that ranges from one cell in column A to over 400 cells
(this can change as well) in column A.

At the moment I have to manually cut and paste the first 50 cell from column
A to Column B, then manually cut and paste the next 50 from column A to
column C, then the next 50 into column D and so on.

The above should be flexible where I can vary the number of cells to be cut
and pasted.

Is there a way that the above can be automated?

Any help offered would be appreciated.

--
Thank U and Regards

Ann

Help with transferring data in one column to multiple columns.
 

JLatham,

Thank you very much, worked exactly as I wanted
--
Thank U and Regards

Ann



"JLatham" wrote:

This code should do it for you - goes into a regular code module. Cut and
paste.
Use [Alt]+[F11] to open the VB Editor. When you get there, from it's menu
choose Insert | Module. Paste this code into the module and close the VB
Editor. To do the work, use Tools | Macro | Macros and select and run the
MoveGroups macro.

Sub MoveGroups()
'asks user for # of cells
'from col. A to move into
'other columns. Each group
'will be moved into individual
'columns beginning with B
Dim ColPointer As Long
Dim TopRow As Long
Dim CellsToMove As Long
Dim LastRowWithData As Long
Dim sourceRng As Range
Dim destRng As Range

CellsToMove = InputBox$("How many rows in a group" _
& " from column A?", "Rows in a Group", 0)
If CellsToMove < 1 Then
Exit Sub ' no work to do
End If
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
LastRowWithData = _
Range("A" & Rows.Count).End(xlUp).Row
Else
' in Excel 2007 (or later)
LastRowWithData = _
Range("A" & Rows.CountLarge).End(xlUp).Row
End If

ColPointer = 1 ' initialize
TopRow = 1 ' initialize
Do Until TopRow LastRowWithData
Set sourceRng = _
Range("A" & TopRow & ":" _
& Range("A" & TopRow).Offset _
(CellsToMove - 1, 0).Address)
Set destRng = _
Range(Range("A1").Offset(0, ColPointer).Address & _
":" & Range("A1").Offset(CellsToMove - 1, _
ColPointer).Address)
destRng.Value = sourceRng.Value
sourceRng.Clear
' update pointers
TopRow = TopRow + CellsToMove
ColPointer = ColPointer + 1
Loop
End Sub


"Ann" wrote:

I have a list of data that ranges from one cell in column A to over 400 cells
(this can change as well) in column A.

At the moment I have to manually cut and paste the first 50 cell from column
A to Column B, then manually cut and paste the next 50 from column A to
column C, then the next 50 into column D and so on.

The above should be flexible where I can vary the number of cells to be cut
and pasted.

Is there a way that the above can be automated?

Any help offered would be appreciated.

--
Thank U and Regards

Ann