PC Review


Reply
Thread Tools Rate Thread

Help with transferring data in one column to multiple columns.

 
 
=?Utf-8?B?QW5u?=
Guest
Posts: n/a
 
      23rd Apr 2007
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

 
Reply With Quote
 
 
 
 
=?Utf-8?B?SkxhdGhhbQ==?=
Guest
Posts: n/a
 
      23rd Apr 2007
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
>

 
Reply With Quote
 
 
 
 
=?Utf-8?B?QW5u?=
Guest
Posts: n/a
 
      23rd Apr 2007
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
> >

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Transferring data from multiple sheets in workbook to one sheet BillB Microsoft Excel Misc 1 12th Feb 2009 12:04 AM
Transferring data from multiple sheets in workbook to one sheet BillB Microsoft Excel Worksheet Functions 0 11th Feb 2009 11:00 PM
Transferring data from multiple sheets in workbook to one sheet BillB Microsoft Excel Worksheet Functions 1 11th Feb 2009 08:17 PM
Problem when trying to convert one column with multiple rows to one row with multiple column marcello Microsoft Excel Programming 1 23rd Feb 2004 04:03 AM
Help! Help! Help! Help! Help! Help! Help! Help! Help! Help! Help! Help! Help! -$- Windows XP Internet Explorer 2 21st Dec 2003 11:45 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 03:35 PM.