Help!
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 -
|