Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose & reorg data from 2 WS to new WB
Transpose & reorg data from sheets "Force" and "Hours" to new workbook
sheet1 I need to adapt this skeleton code .... Enter data Source WB path Enter data Source WB Name Enter data Destin. WB path Enter data Destin. WB Name ' Same data map, in rows & cols, for "Force" & "Hours sheets DateRange = A1: to Last Col. Actvity Range = A1: to Last Row DataRange = A1 : to Last Row - Last Col. For C = 2 to MaxCol(DateRange) For R = 2 to Max(DataRange) ' Write new WB Sheet1 Date = Date(Col(C), Row(1)) Activity = Value(Col(C1),Row(R)) ' From "Force" sheet Force = Value(Col(C),Row(R)) ' From "Hours" sheet Hours = Value(Col(C),Row(R)) Next Next ..... Data Source : Sheet1 "Force" A B C D E 1. Activity Oct1 Oct2 Oct 3 Oct4 2. X 4 13 1 3. Y 6 7 9 ...... Data Source : Sheet1 "Hours" A B C D E 1. Activity Oct1 Oct2 Oct 3 Oct4 2. X 32 104 10 3. Y 72 56 72 ....... Expected result : New Workbook "Alpha" Sheet1 A B C D 1. Date Activity Force Hours 2. Oct1 X 4 32 3. Oct2 X 13 104 4. Oct4 X 1 10 5. Oct2 Y 6 72 6. Oct3 Y 7 56 7. Oct4 Y 79 72 ...... Help appreciated, J.P. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose & reorg data from 2 WS to new WB
Hi
As I understand it you want to create new workbook, where the data is transposed to: Sub ReorgData() Dim SourceWBa As Workbook Dim SourceSHa As Worksheet Dim SourceWBb As Workbook Dim SourceSHb As Worksheet Dim DestCell As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim FileToOpen As Variant Dim LastCol As Long Dim LastRow As Long Dim MyPath As String Application.ScreenUpdating = False FileToOpen = Application.GetOpenFilename _ (filefilter:="Excel Files (*.xls),*.xls", Title:="Open Force workbook") If FileToOpen = False Then Exit Sub 'No workbook selected Set SourceWBa = Workbooks.Open(FileToOpen) FileToOpen = Application.GetOpenFilename _ (filefilter:="Excel Files (*.xls),*.xls", Title:="Open Hours workbook") If FileToOpen = False Then Exit Sub 'No workbook selected Set SourceWBb = Workbooks.Open(FileToOpen) Set DestWB = Workbooks.Add Set SourceSHa = SourceWBa.Worksheets("Sheet1") Set SourceSHb = SourceWBb.Worksheets("Sheet1") Set DestSh = DestWB.Worksheets("Sheet1") Set DestCell = DestSh.Range("A1") LastRow = SourceSHa.Cells(Rows.Count, 1).End(xlUp).Row LastCol = SourceSHa.Cells(1, Columns.Count).End(xlToLeft).Column MyPath = SourceWBa.Path ChDir MyPath 'By default save to source path SaveFileName = Application.GetSaveAsFilename(InitialFilename:="Al pha", _ filefilter:="Excel Files (*.xls), *.xls", Title:="Enter Alpha workbook name") DestCell = "Date" DestCell.Offset(0, 1) = "Activity" DestCell.Offset(0, 2) = "Force" DestCell.Offset(0, 3) = "Hours" Set DestCell = DestCell.Offset(1, 0) For c = 2 To LastCol For r = 2 To LastRow ' Write new WB Sheet1 If SourceSHa.Cells(r, c) < "" Then DestCell = SourceSHa.Cells(1, c) DestCell.Offset(0, 1) = SourceSHa.Cells(r, 1) ' From "Force" sheet DestCell.Offset(0, 2) = SourceSHa.Cells(r, c) ' From "Hours" sheet DestCell.Offset(0, 3) = SourceSHb.Cells(r, c) Set DestCell = DestCell.Offset(1, 0) End If Next Next DestSh.Range("A1").CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, _ Key2:=Range("A2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom SourceWBa.Close SourceWBb.Close DestWB.SaveAs Filename:=SaveFileName Application.ScreenUpdating = True End Sub Regards, Per On 23 Sep., 18:39, u473 wrote: Transpose & reorg data from sheets "Force" and "Hours" to new workbook sheet1 I need to adapt this skeleton code ... Enter data Source WB path Enter data Source WB Name Enter data Destin. WB path Enter data Destin. WB Name ' Same data map, in rows & cols, for "Force" & "Hours sheets DateRange = A1: to Last Col. Actvity Range = A1: to Last Row DataRange = A1 : to Last Row - Last Col. For C = 2 to MaxCol(DateRange) * * * For R = 2 to Max(DataRange) * * * * * * *' Write new WB Sheet1 * * * * * * *Date = Date(Col(C), Row(1)) * * * * * * *Activity = Value(Col(C1),Row(R)) * * * * * * *' From "Force" sheet * * * * * * *Force = Value(Col(C),Row(R)) * * * * * * *' From "Hours" sheet * * * * * * *Hours = Value(Col(C),Row(R)) * * * *Next Next .... Data Source : Sheet1 "Force" * * * A * * * * * * B * * * * C * * * *D * * * *E 1. *Activity * *Oct1 * *Oct2 * Oct 3 *Oct4 2. * X * * * * * * 4 * * * * 13 * * * * * * * * * 1 3. * Y * * * * * * * * * * * * 6 * * * * *7 * * * 9 ..... Data Source : Sheet1 "Hours" * * * A * * * * * * B * * * * C * * * *D * * * * E 1. *Activity * *Oct1 * *Oct2 * *Oct 3 * Oct4 2. * X * * * * * * 32 * * * 104 * * * * * * * * 10 3. * Y * * * * * * * * * * * * 72 * * * *56 * * *72 ...... Expected result : New Workbook "Alpha" Sheet1 * * * A * * * * * * B * * * * C * * * *D 1. *Date * * * Activity *Force * *Hours 2. *Oct1 * * * * * X * * * * 4 * * * * *32 3. *Oct2 * * * * * X * * * *13 * * * *104 4. *Oct4 * * * * * X * * * * *1 * * * * 10 5. *Oct2 * * * * * Y * * * * *6 * * * * 72 6. *Oct3 * * * * * Y * * * * *7 * * * * 56 7. *Oct4 * * * * * Y * * * * 79 * * * *72 ..... Help appreciated, J.P. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose & reorg data from 2 WS to new WB
Thank you Per,
You made my day. I will test it. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Transpose data and retain links to original data | Excel Worksheet Functions | |||
File directory structure reorg | Links and Linking in Excel | |||
Transpose data using Vba | Excel Programming | |||
Transpose data Months & Data to Rows | Excel Discussion (Misc queries) | |||
transpose data | Excel Discussion (Misc queries) |