| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Assembling Data of Many Sheets in one Summary Sheet
Hi Nick/Norman,
I tried to use the macro provided by you. Its giving me the output but not in the way i wanted. Right Now what i am using is: Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Sub Test3() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("Summary").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "Summary" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name Then Last = LastCol(DestSh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range("d5:d168").Copy DestSh.Cells(1, Last + 1) End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub What the macro is doing is copying the values of respective cells and pasting it into new sheet (Summary) in the same cell. Sheet1 Sheet2 Sheet3 Sheet4 D10 D10 D10 D10 D12 D12 D12 D12 D14 D14 D14 D14 D20 D20 D20 D20 D22 D22 D22 D22 D24 D24 D24 D24 D30 D30 D30 D30 D32 D32 D32 D32 D48 D48 D48 D48 D50 D50 D50 D50 D52 D52 D52 D52 D54 D54 D54 D54 D70 D70 D70 D70 D87 D87 D87 D87 D102 D102 D102 D102 D118 D118 D118 D118 D137 D137 D137 D137 D141 D141 D141 D141 D145 D145 D145 D145 D162 D162 D162 D162 D164 D164 D164 D164 D166 D166 D166 D166 D168 D168 D168 D168 But i want the optuput in other format Data of Sheet1 D10 D12 D14 D20 D22 D24 Data of Sheet2 D10 D12 D14 D20 D22 D24 Data of Sheet3 D10 D12 D14 D20 D22 D24 Data of Sheet4 D10 D12 D14 D20 D22 D24 How can i do it. Can you pls amend the above mentioned macro so that i can get the result as per my requiremnet. Thanks Akash |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Assembling Data of Many Sheets in one Summary Sheet
Transpose ?
NickHK "Akash" wrote in message oups.com... Hi Nick/Norman, I tried to use the macro provided by you. Its giving me the output but not in the way i wanted. Right Now what i am using is: Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Sub Test3() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("Summary").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "Summary" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name Then Last = LastCol(DestSh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range("d5:d168").Copy DestSh.Cells(1, Last + 1) End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub What the macro is doing is copying the values of respective cells and pasting it into new sheet (Summary) in the same cell. Sheet1 Sheet2 Sheet3 Sheet4 D10 D10 D10 D10 D12 D12 D12 D12 D14 D14 D14 D14 D20 D20 D20 D20 D22 D22 D22 D22 D24 D24 D24 D24 D30 D30 D30 D30 D32 D32 D32 D32 D48 D48 D48 D48 D50 D50 D50 D50 D52 D52 D52 D52 D54 D54 D54 D54 D70 D70 D70 D70 D87 D87 D87 D87 D102 D102 D102 D102 D118 D118 D118 D118 D137 D137 D137 D137 D141 D141 D141 D141 D145 D145 D145 D145 D162 D162 D162 D162 D164 D164 D164 D164 D166 D166 D166 D166 D168 D168 D168 D168 But i want the optuput in other format Data of Sheet1 D10 D12 D14 D20 D22 D24 Data of Sheet2 D10 D12 D14 D20 D22 D24 Data of Sheet3 D10 D12 D14 D20 D22 D24 Data of Sheet4 D10 D12 D14 D20 D22 D24 How can i do it. Can you pls amend the above mentioned macro so that i can get the result as per my requiremnet. Thanks Akash |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Assembling Data of Many Sheets in one Summary Sheet
hi Nick,
I know the about the fuction Transpose. But the problem is the data is is not comming in the way i wanted. I mean to say. Data is comming in this way. D10 D12 D14 D16 I want it D10 D11 D12 D13 I dont want any black cell. What should i do in this regards. Akash On May 14, 11:21 am, "NickHK" wrote: Transpose ? NickHK "Akash" wrote in message oups.com... Hi Nick/Norman, I tried to use the macro provided by you. Its giving me the output but not in the way i wanted. Right Now what i am using is: Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Sub Test3() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("Summary").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "Summary" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name Then Last = LastCol(DestSh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range("d5:d168").Copy DestSh.Cells(1, Last + 1) End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub What the macro is doing is copying the values of respective cells and pasting it into new sheet (Summary) in the same cell. Sheet1 Sheet2 Sheet3 Sheet4 D10 D10 D10 D10 D12 D12 D12 D12 D14 D14 D14 D14 D20 D20 D20 D20 D22 D22 D22 D22 D24 D24 D24 D24 D30 D30 D30 D30 D32 D32 D32 D32 D48 D48 D48 D48 D50 D50 D50 D50 D52 D52 D52 D52 D54 D54 D54 D54 D70 D70 D70 D70 D87 D87 D87 D87 D102 D102 D102 D102 D118 D118 D118 D118 D137 D137 D137 D137 D141 D141 D141 D141 D145 D145 D145 D145 D162 D162 D162 D162 D164 D164 D164 D164 D166 D166 D166 D166 D168 D168 D168 D168 But i want the optuput in other format Data of Sheet1 D10 D12 D14 D20 D22 D24 Data of Sheet2 D10 D12 D14 D20 D22 D24 Data of Sheet3 D10 D12 D14 D20 D22 D24 Data of Sheet4 D10 D12 D14 D20 D22 D24 How can i do it. Can you pls amend the above mentioned macro so that i can get the result as per my requiremnet. Thanks Akash- Hide quoted text - - Show quoted text - |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Assembling Data of Many Sheets in one Summary Sheet
This is nothing to do with the requirement you posted before - changing
column paste to row paste. Also, you are using sh.Range("d5:d168").Copy so you should be getting your "new" requirements, assuming there are no blank cells in your range. NickHK "Akash" wrote in message ups.com... hi Nick, I know the about the fuction Transpose. But the problem is the data is is not comming in the way i wanted. I mean to say. Data is comming in this way. D10 D12 D14 D16 I want it D10 D11 D12 D13 I dont want any black cell. What should i do in this regards. Akash On May 14, 11:21 am, "NickHK" wrote: Transpose ? NickHK "Akash" wrote in message oups.com... Hi Nick/Norman, I tried to use the macro provided by you. Its giving me the output but not in the way i wanted. Right Now what i am using is: Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Sub Test3() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("Summary").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "Summary" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name Then Last = LastCol(DestSh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range("d5:d168").Copy DestSh.Cells(1, Last + 1) End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub What the macro is doing is copying the values of respective cells and pasting it into new sheet (Summary) in the same cell. Sheet1 Sheet2 Sheet3 Sheet4 D10 D10 D10 D10 D12 D12 D12 D12 D14 D14 D14 D14 D20 D20 D20 D20 D22 D22 D22 D22 D24 D24 D24 D24 D30 D30 D30 D30 D32 D32 D32 D32 D48 D48 D48 D48 D50 D50 D50 D50 D52 D52 D52 D52 D54 D54 D54 D54 D70 D70 D70 D70 D87 D87 D87 D87 D102 D102 D102 D102 D118 D118 D118 D118 D137 D137 D137 D137 D141 D141 D141 D141 D145 D145 D145 D145 D162 D162 D162 D162 D164 D164 D164 D164 D166 D166 D166 D166 D168 D168 D168 D168 But i want the optuput in other format Data of Sheet1 D10 D12 D14 D20 D22 D24 Data of Sheet2 D10 D12 D14 D20 D22 D24 Data of Sheet3 D10 D12 D14 D20 D22 D24 Data of Sheet4 D10 D12 D14 D20 D22 D24 How can i do it. Can you pls amend the above mentioned macro so that i can get the result as per my requiremnet. Thanks Akash- Hide quoted text - - Show quoted text - |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| summary sheet across multiple sheets | Excel Discussion (Misc queries) | |||
| Assembling Data of 100 Sheets in one Summary Sheet | Excel Programming | |||
| Accumulating Data From Sheets and preparing one summary sheet. | Excel Programming | |||
| Summary Sheet help with multiple sheets | Excel Discussion (Misc queries) | |||
| data entered on multiple sheets also added to summary sheet | Excel Programming | |||
Linear Mode
