Thread: Help!
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
JLatham JLatham is offline
external usenet poster
 
Posts: 3,365
Default Help!

This code should do the trick for you. To get the code into your workbook:
[Alt]+[F11] to get into the VB Editor. From the VB Editor's menu, choose
Insert | Module. Cut this code and paste it into the module. Close the VB
Editor.

Select the sheet with the data to be manipulated and use Tools | Macro |
Macros to select and [Run] the code.

Sub Transpose20Columns()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'if you would like a blank row between groups
'change RowPointerIncrease from 19 to 20
'leave all others as they are
'
Const RowPointerIncrease = 19
'
Const RangeSizeIncrease = 18
Dim src_rOffset As Long
Dim dest_rPointer As Long
Dim ColAContent As Variant ' type unknown
Dim LastSourceRow As Long
Dim srcSheetName As String
Dim destSheetName As String
Dim srcRange As Range
Dim destRange As Range
Dim MaxRows As Long
Dim LC As Integer

If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
LastSourceRow = Range("A" & _
Rows.Count).End(xlUp).Row
MaxRows = Rows.Count
Else
'in Excel 2007 (or later)
LastSourceRow = Range("A" & _
Rows.countlarge).End(xlUp).Row
MaxRows = Rows.countlarge
End If
If (LastSourceRow * RowPointerIncrease) MaxRows Then
MsgBox "Not Enough Rows Available to Move the Data" _
& vbCrLf & "Move Requires " _
& (LastSourceRow * RowPointerIncrease) _
& " rows. Only " & MaxRows & " available.", _
vbOKOnly, "Not Enough Room - Quitting"
Exit Sub
End If
srcSheetName = ActiveSheet.Name
'add a new sheet to the workbook and
'save its name
Worksheets.Add after:=Worksheets(srcSheetName)
destSheetName = ActiveSheet.Name
Worksheets(srcSheetName).Select
dest_rPointer = 1 ' initialize

For src_rOffset = 0 To LastSourceRow - 1
ColAContent = _
Worksheets(srcSheetName).Range("A1"). _
Offset(src_rOffset, 0)
Set destRange = _
Worksheets(destSheetName).Range("A" _
& dest_rPointer & ":A" & dest_rPointer _
+ RangeSizeIncrease)
destRange.Value = ColAContent
'transpose the data
Set srcRange = _
Worksheets(srcSheetName).Range("B" _
& src_rOffset + 1 & ":T" & src_rOffset + 1)
Set destRange = Worksheets(destSheetName). _
Range("B" & dest_rPointer & ":B" _
& dest_rPointer + RangeSizeIncrease)
For LC = 1 To srcRange.Columns.Count
destRange.Cells(LC, 1) = srcRange.Cells(1, LC)
Next
dest_rPointer = dest_rPointer + RowPointerIncrease
Next

End Sub


"Dolphy" wrote:

Hi All,

I have collated some records on an excel document. I need to split
this document.

The document consists of twenty columns and x number of rows.

I would like to split the master document in the below format.

I need all documents to have Column A as the first column then Column
B will be have will have Columns B to T.

The new excel documents will have:

Column A and Column B
Column A and Column C
Column A and Column D
through to ....
Coulmn A and Column T

Any help would be greatly appreciated.

Rgds,
Dolphy