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

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

If you need each new group created to be placed into a separate worksheet,
then use this code instead:

Sub Transpose20Columns()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'
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
srcSheetName = ActiveSheet.Name
'add a new sheet to the workbook and
'save its name
Worksheets(srcSheetName).Select
Application.ScreenUpdating = False
For src_rOffset = 0 To LastSourceRow - 1
'add a new sheet to the workbook and
'for each grouping!
Worksheets.Add after:=Worksheets(Worksheets.Count)
destSheetName = ActiveSheet.Name
Worksheets(srcSheetName).Select
dest_rPointer = 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
Next
Application.ScreenUpdating = True
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

Hi,

Thanks for the macro, but it's outputting the wrong data on sperate
spreadsheets.

A bit info about my data: The excel doc is populated from A1 through
to A600 and there are 22 Culmuns (V) V1 to V600

What it's outputting is:

Sheet2: Column A is populated by A1 and Column B is Populated by A2
through to V2

I would like the spreadsheet split up so that Column A remains the
same on all sheets, and the each sheet has Column B with info from
Colmun V2.

The sheets will have the following data:

Sheet2: Column A (data from Column A sheet1) Column B (data from
Column B sheet1)
Sheet3: Column A (data from Column A sheet1) Column B (data from
Column C sheet1)
Sheet4: Column A (data from Column A sheet1) Column B (data from
Column D sheet1)

and so on.

Thanking you in advanced.

Rgds,
Dolphy



On May 7, 2:53 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
If you need each new group created to be placed into a separate worksheet,
then use this code instead:

Sub Transpose20Columns()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'
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
srcSheetName = ActiveSheet.Name
'add a new sheet to the workbook and
'save its name
Worksheets(srcSheetName).Select
Application.ScreenUpdating = False
For src_rOffset = 0 To LastSourceRow - 1
'add a new sheet to the workbook and
'for each grouping!
Worksheets.Add after:=Worksheets(Worksheets.Count)
destSheetName = ActiveSheet.Name
Worksheets(srcSheetName).Select
dest_rPointer = 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
Next
Application.ScreenUpdating = True
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- Hide quoted text -

- Show quoted text -

Let me look and refresh my memory on this and see where I have messed up the
code. I'll be back shortly with another stab at its tiny, black, hard heart
<g.

"Dolphy" wrote:

Hi,

Thanks for the macro, but it's outputting the wrong data on sperate
spreadsheets.

A bit info about my data: The excel doc is populated from A1 through
to A600 and there are 22 Culmuns (V) V1 to V600

What it's outputting is:

Sheet2: Column A is populated by A1 and Column B is Populated by A2
through to V2

I would like the spreadsheet split up so that Column A remains the
same on all sheets, and the each sheet has Column B with info from
Colmun V2.

The sheets will have the following data:

Sheet2: Column A (data from Column A sheet1) Column B (data from
Column B sheet1)
Sheet3: Column A (data from Column A sheet1) Column B (data from
Column C sheet1)
Sheet4: Column A (data from Column A sheet1) Column B (data from
Column D sheet1)

and so on.

Thanking you in advanced.

Rgds,
Dolphy



On May 7, 2:53 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
If you need each new group created to be placed into a separate worksheet,
then use this code instead:

Sub Transpose20Columns()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'
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
srcSheetName = ActiveSheet.Name
'add a new sheet to the workbook and
'save its name
Worksheets(srcSheetName).Select
Application.ScreenUpdating = False
For src_rOffset = 0 To LastSourceRow - 1
'add a new sheet to the workbook and
'for each grouping!
Worksheets.Add after:=Worksheets(Worksheets.Count)
destSheetName = ActiveSheet.Name
Worksheets(srcSheetName).Select
dest_rPointer = 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
Next
Application.ScreenUpdating = True
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- Hide quoted text -

- Show quoted text -

See if this code isn't closer to what you need. It will add sheets, giving
each a name like "A_and_B", "A_and_C", ... "A_and_V" and will put the
original column A on each sheet in column A of the new sheet, then it will
put columns B, C, D...V into column B on each newly created sheet.

Sub CopyColumnPairs()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'Can only be run once without deleting the
'sheets that were created because it will
'fail when it attempts to give a sheet
'a name that already exists in the workbook.
'
Dim LastSourceRow As Long
Dim srcSheetName As String
Dim destSheetName As String
Dim ColAUsedAddress As String
Dim srcARange As Range ' for column A
Dim destARange As Range
Dim anyAddressRange As String
Dim srcRange As Range ' for columns B:V
Dim destRange As Range ' for column B on each new sheet
Dim sheetLoop As Integer

If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
LastSourceRow = Range("A" & _
Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later)
LastSourceRow = Range("A" & _
Rows.countlarge).End(xlUp).Row
End If
srcSheetName = ActiveSheet.Name
'get data from column A - will be
'source for column A on all new sheets
ColAUsedAddress = "A1:A" & LastSourceRow
Set srcARange = ActiveSheet.Range(ColAUsedAddress)

Application.ScreenUpdating = False
For sheetLoop = Range("A1").Column To Range("U1").Column
Worksheets(srcSheetName).Select
anyAddressRange = Range("A1").Offset(0, sheetLoop).Address _
& ":" & Range("A1").Offset(LastSourceRow - 1, _
sheetLoop).Address
Set srcRange = ActiveSheet.Range(anyAddressRange)
' add a new worksheet, becomes active
Worksheets.Add after:=Worksheets(Worksheets.Count)
'make a name for the new sheet
destSheetName = _
Right(anyAddressRange, Len(anyAddressRange) - _
InStr(anyAddressRange, ":"))
destSheetName = "A_and_" & Mid(destSheetName, 2, _
InStr(2, destSheetName, "$") - 2)
ActiveSheet.Name = destSheetName
'set up to echo Col A data
Set destARange = ActiveSheet.Range(ColAUsedAddress)
'echo Col A data
destARange.Value = srcARange.Value
'set up to put next col from main sheet in col B
anyAddressRange = "B1:B" & LastSourceRow
Set destRange = ActiveSheet.Range(anyAddressRange)
'copy to new sheet, column B
destRange.Value = srcRange.Value
Next ' sheetLoop end
Application.ScreenUpdating = True
End Sub


"Dolphy" wrote:

Hi,

Thanks for the macro, but it's outputting the wrong data on sperate
spreadsheets.

A bit info about my data: The excel doc is populated from A1 through
to A600 and there are 22 Culmuns (V) V1 to V600

What it's outputting is:

Sheet2: Column A is populated by A1 and Column B is Populated by A2
through to V2

I would like the spreadsheet split up so that Column A remains the
same on all sheets, and the each sheet has Column B with info from
Colmun V2.

The sheets will have the following data:

Sheet2: Column A (data from Column A sheet1) Column B (data from
Column B sheet1)
Sheet3: Column A (data from Column A sheet1) Column B (data from
Column C sheet1)
Sheet4: Column A (data from Column A sheet1) Column B (data from
Column D sheet1)

and so on.

Thanking you in advanced.

Rgds,
Dolphy



On May 7, 2:53 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
If you need each new group created to be placed into a separate worksheet,
then use this code instead:

Sub Transpose20Columns()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'
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
srcSheetName = ActiveSheet.Name
'add a new sheet to the workbook and
'save its name
Worksheets(srcSheetName).Select
Application.ScreenUpdating = False
For src_rOffset = 0 To LastSourceRow - 1
'add a new sheet to the workbook and
'for each grouping!
Worksheets.Add after:=Worksheets(Worksheets.Count)
destSheetName = ActiveSheet.Name
Worksheets(srcSheetName).Select
dest_rPointer = 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
Next
Application.ScreenUpdating = True
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- Hide quoted text -

- Show quoted text -

Hi,

You are a CHAMPION!!!!!!!!!

Thank you for your assistance and great work.

Rgds,
Dolphy

On Jun 5, 6:53 am, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
See if this code isn't closer to what you need. It will add sheets, giving
each a name like "A_and_B", "A_and_C", ... "A_and_V" and will put the
original column A on each sheet in column A of the new sheet, then it will
put columns B, C, D...V into column B on each newly created sheet.

Sub CopyColumnPairs()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'Can only be run once without deleting the
'sheets that were created because it will
'fail when it attempts to give a sheet
'a name that already exists in the workbook.
'
Dim LastSourceRow As Long
Dim srcSheetName As String
Dim destSheetName As String
Dim ColAUsedAddress As String
Dim srcARange As Range ' for column A
Dim destARange As Range
Dim anyAddressRange As String
Dim srcRange As Range ' for columns B:V
Dim destRange As Range ' for column B on each new sheet
Dim sheetLoop As Integer

If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
LastSourceRow = Range("A" & _
Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later)
LastSourceRow = Range("A" & _
Rows.countlarge).End(xlUp).Row
End If
srcSheetName = ActiveSheet.Name
'get data from column A - will be
'source for column A on all new sheets
ColAUsedAddress = "A1:A" & LastSourceRow
Set srcARange = ActiveSheet.Range(ColAUsedAddress)

Application.ScreenUpdating = False
For sheetLoop = Range("A1").Column To Range("U1").Column
Worksheets(srcSheetName).Select
anyAddressRange = Range("A1").Offset(0, sheetLoop).Address _
& ":" & Range("A1").Offset(LastSourceRow - 1, _
sheetLoop).Address
Set srcRange = ActiveSheet.Range(anyAddressRange)
' add a new worksheet, becomes active
Worksheets.Add after:=Worksheets(Worksheets.Count)
'make a name for the new sheet
destSheetName = _
Right(anyAddressRange, Len(anyAddressRange) - _
InStr(anyAddressRange, ":"))
destSheetName = "A_and_" & Mid(destSheetName, 2, _
InStr(2, destSheetName, "$") - 2)
ActiveSheet.Name = destSheetName
'set up to echo Col A data
Set destARange = ActiveSheet.Range(ColAUsedAddress)
'echo Col A data
destARange.Value = srcARange.Value
'set up to put next col from main sheet in col B
anyAddressRange = "B1:B" & LastSourceRow
Set destRange = ActiveSheet.Range(anyAddressRange)
'copy to new sheet, column B
destRange.Value = srcRange.Value
Next ' sheetLoop end
Application.ScreenUpdating = True
End Sub



"Dolphy" wrote:
Hi,

Thanks for the macro, but it's outputting the wrong data on sperate
spreadsheets.

A bit info about my data: The excel doc is populated from A1 through
to A600 and there are 22 Culmuns (V) V1 to V600

What it's outputting is:

Sheet2: Column A is populated by A1 and Column B is Populated by A2
through to V2

I would like the spreadsheet split up so that Column A remains the
same on all sheets, and the each sheet has Column B with info from
Colmun V2.

The sheets will have the following data:

Sheet2: Column A (data from Column A sheet1) Column B (data from
Column B sheet1)
Sheet3: Column A (data from Column A sheet1) Column B (data from
Column C sheet1)
Sheet4: Column A (data from Column A sheet1) Column B (data from
Column D sheet1)

and so on.

Thanking you in advanced.

Rgds,
Dolphy

On May 7, 2:53 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
If you need each new group created to be placed into a separate worksheet,
then use this code instead:

Sub Transpose20Columns()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'
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
srcSheetName = ActiveSheet.Name
'add a new sheet to the workbook and
'save its name
Worksheets(srcSheetName).Select
Application.ScreenUpdating = False
For src_rOffset = 0 To LastSourceRow - 1
'add a new sheet to the workbook and
'for each grouping!
Worksheets.Add after:=Worksheets(Worksheets.Count)
destSheetName = ActiveSheet.Name
Worksheets(srcSheetName).Select
dest_rPointer = 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
Next
Application.ScreenUpdating = True
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- Hide quoted text -

- Show quoted text -- Hide quoted text -

- Show quoted text -

Glad we finally got it right.

"JLatham" wrote:

See if this code isn't closer to what you need. It will add sheets, giving
each a name like "A_and_B", "A_and_C", ... "A_and_V" and will put the
original column A on each sheet in column A of the new sheet, then it will
put columns B, C, D...V into column B on each newly created sheet.

Sub CopyColumnPairs()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'Can only be run once without deleting the
'sheets that were created because it will
'fail when it attempts to give a sheet
'a name that already exists in the workbook.
'
Dim LastSourceRow As Long
Dim srcSheetName As String
Dim destSheetName As String
Dim ColAUsedAddress As String
Dim srcARange As Range ' for column A
Dim destARange As Range
Dim anyAddressRange As String
Dim srcRange As Range ' for columns B:V
Dim destRange As Range ' for column B on each new sheet
Dim sheetLoop As Integer

If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
LastSourceRow = Range("A" & _
Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later)
LastSourceRow = Range("A" & _
Rows.countlarge).End(xlUp).Row
End If
srcSheetName = ActiveSheet.Name
'get data from column A - will be
'source for column A on all new sheets
ColAUsedAddress = "A1:A" & LastSourceRow
Set srcARange = ActiveSheet.Range(ColAUsedAddress)

Application.ScreenUpdating = False
For sheetLoop = Range("A1").Column To Range("U1").Column
Worksheets(srcSheetName).Select
anyAddressRange = Range("A1").Offset(0, sheetLoop).Address _
& ":" & Range("A1").Offset(LastSourceRow - 1, _
sheetLoop).Address
Set srcRange = ActiveSheet.Range(anyAddressRange)
' add a new worksheet, becomes active
Worksheets.Add after:=Worksheets(Worksheets.Count)
'make a name for the new sheet
destSheetName = _
Right(anyAddressRange, Len(anyAddressRange) - _
InStr(anyAddressRange, ":"))
destSheetName = "A_and_" & Mid(destSheetName, 2, _
InStr(2, destSheetName, "$") - 2)
ActiveSheet.Name = destSheetName
'set up to echo Col A data
Set destARange = ActiveSheet.Range(ColAUsedAddress)
'echo Col A data
destARange.Value = srcARange.Value
'set up to put next col from main sheet in col B
anyAddressRange = "B1:B" & LastSourceRow
Set destRange = ActiveSheet.Range(anyAddressRange)
'copy to new sheet, column B
destRange.Value = srcRange.Value
Next ' sheetLoop end
Application.ScreenUpdating = True
End Sub


"Dolphy" wrote:

Hi,

Thanks for the macro, but it's outputting the wrong data on sperate
spreadsheets.

A bit info about my data: The excel doc is populated from A1 through
to A600 and there are 22 Culmuns (V) V1 to V600

What it's outputting is:

Sheet2: Column A is populated by A1 and Column B is Populated by A2
through to V2

I would like the spreadsheet split up so that Column A remains the
same on all sheets, and the each sheet has Column B with info from
Colmun V2.

The sheets will have the following data:

Sheet2: Column A (data from Column A sheet1) Column B (data from
Column B sheet1)
Sheet3: Column A (data from Column A sheet1) Column B (data from
Column C sheet1)
Sheet4: Column A (data from Column A sheet1) Column B (data from
Column D sheet1)

and so on.

Thanking you in advanced.

Rgds,
Dolphy



On May 7, 2:53 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
If you need each new group created to be placed into a separate worksheet,
then use this code instead:

Sub Transpose20Columns()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'
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
srcSheetName = ActiveSheet.Name
'add a new sheet to the workbook and
'save its name
Worksheets(srcSheetName).Select
Application.ScreenUpdating = False
For src_rOffset = 0 To LastSourceRow - 1
'add a new sheet to the workbook and
'for each grouping!
Worksheets.Add after:=Worksheets(Worksheets.Count)
destSheetName = ActiveSheet.Name
Worksheets(srcSheetName).Select
dest_rPointer = 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
Next
Application.ScreenUpdating = True
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- Hide quoted text -

- Show quoted text -

Hi,

Now I'm being pushy.

I was wondering if this macro could be modified so that the results
are outputted in new spreadsheet iinstead of work sheets?

Rgds,
Dolphy

On Jun 5, 12:50 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
Glad we finally got it right.



"JLatham" wrote:
See if this code isn't closer to what you need. It will add sheets, giving
each a name like "A_and_B", "A_and_C", ... "A_and_V" and will put the
original column A on each sheet in column A of the new sheet, then it will
put columns B, C, D...V into column B on each newly created sheet.

Sub CopyColumnPairs()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'Can only be run once without deleting the
'sheets that were created because it will
'fail when it attempts to give a sheet
'a name that already exists in the workbook.
'
Dim LastSourceRow As Long
Dim srcSheetName As String
Dim destSheetName As String
Dim ColAUsedAddress As String
Dim srcARange As Range ' for column A
Dim destARange As Range
Dim anyAddressRange As String
Dim srcRange As Range ' for columns B:V
Dim destRange As Range ' for column B on each new sheet
Dim sheetLoop As Integer

If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
LastSourceRow = Range("A" & _
Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later)
LastSourceRow = Range("A" & _
Rows.countlarge).End(xlUp).Row
End If
srcSheetName = ActiveSheet.Name
'get data from column A - will be
'source for column A on all new sheets
ColAUsedAddress = "A1:A" & LastSourceRow
Set srcARange = ActiveSheet.Range(ColAUsedAddress)

Application.ScreenUpdating = False
For sheetLoop = Range("A1").Column To Range("U1").Column
Worksheets(srcSheetName).Select
anyAddressRange = Range("A1").Offset(0, sheetLoop).Address _
& ":" & Range("A1").Offset(LastSourceRow - 1, _
sheetLoop).Address
Set srcRange = ActiveSheet.Range(anyAddressRange)
' add a new worksheet, becomes active
Worksheets.Add after:=Worksheets(Worksheets.Count)
'make a name for the new sheet
destSheetName = _
Right(anyAddressRange, Len(anyAddressRange) - _
InStr(anyAddressRange, ":"))
destSheetName = "A_and_" & Mid(destSheetName, 2, _
InStr(2, destSheetName, "$") - 2)
ActiveSheet.Name = destSheetName
'set up to echo Col A data
Set destARange = ActiveSheet.Range(ColAUsedAddress)
'echo Col A data
destARange.Value = srcARange.Value
'set up to put next col from main sheet in col B
anyAddressRange = "B1:B" & LastSourceRow
Set destRange = ActiveSheet.Range(anyAddressRange)
'copy to new sheet, column B
destRange.Value = srcRange.Value
Next ' sheetLoop end
Application.ScreenUpdating = True
End Sub

"Dolphy" wrote:

Hi,

Thanks for the macro, but it's outputting the wrong data on sperate
spreadsheets.

A bit info about my data: The excel doc is populated from A1 through
to A600 and there are 22 Culmuns (V) V1 to V600

What it's outputting is:

Sheet2: Column A is populated by A1 and Column B is Populated by A2
through to V2

I would like the spreadsheet split up so that Column A remains the
same on all sheets, and the each sheet has Column B with info from
Colmun V2.

The sheets will have the following data:

Sheet2: Column A (data from Column A sheet1) Column B (data from
Column B sheet1)
Sheet3: Column A (data from Column A sheet1) Column B (data from
Column C sheet1)
Sheet4: Column A (data from Column A sheet1) Column B (data from
Column D sheet1)

and so on.

Thanking you in advanced.

Rgds,
Dolphy

On May 7, 2:53 pm, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
If you need each new group created to be placed into a separate worksheet,
then use this code instead:

Sub Transpose20Columns()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own worksheet
'
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
srcSheetName = ActiveSheet.Name
'add a new sheet to the workbook and
'save its name
Worksheets(srcSheetName).Select
Application.ScreenUpdating = False
For src_rOffset = 0 To LastSourceRow - 1
'add a new sheet to the workbook and
'for each grouping!
Worksheets.Add after:=Worksheets(Worksheets.Count)
destSheetName = ActiveSheet.Name
Worksheets(srcSheetName).Select
dest_rPointer = 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
Next
Application.ScreenUpdating = True
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- Hide quoted text -

- Show quoted text -- Hide quoted text -

- Show quoted text -

I think we could probably alter it to put the results out on a single, new
sheet. Question is, how would you want the pairing to appear? Before we
paired A & B, A&C, A&D ... A&V on separate sheets. So how would things be on
a single sheet?

"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

Hi,

Columns AB would be on a new spreadheet
Columns AC would be on a new spreadheet
Columns AD would be on a new spreadheet
through to Ax

After running the macro it would leave the new spreadsheets open, or
save them in c:\temp

Rgds,
Dolphy

On Jun 13, 11:36 am, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
I think we could probably alter it to put the results out on a single, new
sheet. Question is, how would you want the pairing to appear? Before we
paired A & B, A&C, A&D ... A&V on separate sheets. So how would things be on
a single sheet?



"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- Hide quoted text -

- Show quoted text -

OK, I understand - each in an entirely new workbook. Had one of those
frain-bart things when I read 'spreadsheet'. That shouldn't be too difficult.

"Dolphy" wrote:

Hi,

Columns AB would be on a new spreadheet
Columns AC would be on a new spreadheet
Columns AD would be on a new spreadheet
through to Ax

After running the macro it would leave the new spreadsheets open, or
save them in c:\temp

Rgds,
Dolphy

On Jun 13, 11:36 am, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
I think we could probably alter it to put the results out on a single, new
sheet. Question is, how would you want the pairing to appear? Before we
paired A & B, A&C, A&D ... A&V on separate sheets. So how would things be on
a single sheet?



"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- Hide quoted text -

- Show quoted text -

Ok, this code will create a new workbook for each pair of column data. Each
new workbook will be given a name like previously given to the separate, new
worksheets. It will be saved to c:\temp (which must exist before running the
code), and it will be left open. You should delete/move any files already in
c:\temp that have names such as those that will be created (A_And_B.xls ...
A_And_V.xls) so that you won't be nagged to death with "File
Exists...Overwrite?" prompts. I didn't put any code in it to do away with
those prompts.

Here you go:

Sub CopyColumnPairsToSeparateWorkbooks()
'You must choose/select the sheet with the data to
'be re-arranged before calling this macro.
'
'This code will put each group
'created into its own workBOOK
' Each workbook will be named [email protected]
' where @ is the letter of the adjacent column information in it.
' Each workbook will be saved into the path designated in
' constant newWBSavePath, and that path must already exist
' before running the macro.
' Each of the workbooks is also left open after the save.
'
' Any existing .xls files in that path with names
' that will be created should be moved/deleted so that
' you are not plagued with "file exists, overwrite?"
' prompts.
'
Const newWBSavePath = "c:\temp\" ' must exist!

Dim LastSourceRow As Long
Dim srcSheetName As String
Dim destSheetName As String
Dim ColAUsedAddress As String
Dim srcARange As Range ' for column A
Dim destARange As Range
Dim anyAddressRange As String
Dim srcRange As Range ' for columns B:V
Dim destRange As Range ' for column B on each new sheet
Dim sheetLoop As Integer
Dim thisWB As Workbook
Dim newWB As Workbook

If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
LastSourceRow = Range("A" & _
Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later)
LastSourceRow = Range("A" & _
Rows.countlarge).End(xlUp).Row
End If
Set thisWB = ThisWorkbook
srcSheetName = thisWB.ActiveSheet.Name
'get data from column A - will be
'source for column A on all new sheets
ColAUsedAddress = "A1:A" & LastSourceRow
Set srcARange = thisWB.ActiveSheet.Range(ColAUsedAddress)

Application.ScreenUpdating = False
For sheetLoop = Range("A1").Column To Range("U1").Column
thisWB.Worksheets(srcSheetName).Select
anyAddressRange = Range("A1").Offset(0, sheetLoop).Address _
& ":" & Range("A1").Offset(LastSourceRow - 1, _
sheetLoop).Address
Set srcRange = thisWB.ActiveSheet.Range(anyAddressRange)
' add new WORKBOOK, it becomes active
Workbooks.Add
Set newWB = ActiveWorkbook
'make a name for the new sheet
destSheetName = _
Right(anyAddressRange, Len(anyAddressRange) - _
InStr(anyAddressRange, ":"))
destSheetName = "A_and_" & Mid(destSheetName, 2, _
InStr(2, destSheetName, "$") - 2)
newWB.ActiveSheet.Name = destSheetName
'set up to echo Col A data
Set destARange = newWB.ActiveSheet.Range(ColAUsedAddress)
'echo Col A data
destARange.Value = srcARange.Value
'set up to put next col from main sheet in col B
anyAddressRange = "B1:B" & LastSourceRow
Set destRange = _
newWB.Worksheets(destSheetName).Range(anyAddressRa nge)
'copy to new sheet, column B
destRange.Value = srcRange.Value
'save the new workbook with an appropriate name
'and leave it open
newWB.SaveAs newWBSavePath & destSheetName & ".xls"
thisWB.Activate ' back to this workbook for another round
Set newWB = Nothing
Set destARange = Nothing
Set srcRange = Nothing
Next ' sheetLoop end
Application.ScreenUpdating = True
End Sub


"Dolphy" wrote:

Hi,

Columns AB would be on a new spreadheet
Columns AC would be on a new spreadheet
Columns AD would be on a new spreadheet
through to Ax

After running the macro it would leave the new spreadsheets open, or
save them in c:\temp

Rgds,
Dolphy

On Jun 13, 11:36 am, JLatham <HelpFrom @ Jlathamsite.com.(removethis)
wrote:
I think we could probably alter it to put the results out on a single, new
sheet. Question is, how would you want the pairing to appear? Before we
paired A & B, A&C, A&D ... A&V on separate sheets. So how would things be on
a single sheet?



"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- Hide quoted text -

- Show quoted text -