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 -