Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Mmm tricky- but i'm sure someone out there can help!
Hi everyone, I've been trying to solve this for a while but its got me tearing my hair out!!! I want to create a macro that when run will summarise columns or rows from different worksheets and return them to a new sheet that is inserted at the front of the workbook. In an ideal world the macro would bring up a box that would ask for the rows or columns to be summarised. I would then enter the required rows/columns ie, column a, click on ok and every column a in all the worksheets would be returned to a new sheet at the front of the book. ie if there are 3 sheets, column a of sheet 1 would be returned to column a of new sheet, column a of sheet 2 would be returned to column b of new sheet... etc to allow comparison. I appreciate this is in all likelihood a large query but if anyone can help in any way i'd be very grateful! ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~View and post usenet messages directly from http://www.ExcelForum.com/ ~~Now Available: Financial Statements.xls, a step by step guide to creating financial statements |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Mmm tricky- but i'm sure someone out there can help!
Option Explicit
Sub Summarize() Dim rng As Range, rng1 As Range Dim sh As Worksheet, sh1 As Worksheet Dim lngCol As Long, lngRow As Long On Error Resume Next Set rng = Application.InputBox("Select entirerow or entire column", Type:=8) Set sh1 = Worksheets("Summary") On Error GoTo 0 If rng.Rows.Count 1 Then lngCol = rng.Column Else lngRow = rng.Row End If If Not sh1 Is Nothing Then Application.DisplayAlerts = False sh1.Delete Application.DisplayAlerts = True End If Set sh = Worksheets.Add(Befo=Worksheets(1)) sh.Name = "Summary" For Each sh1 In ActiveWorkbook.Worksheets If sh1.Name < "Summary" Then If lngCol 0 Then sh1.Columns(lngCol).Copy Destination:= _ sh.Cells(1, "IV").End(xlToLeft)(1, 2) Else sh1.Rows(lngRow).Copy Destination:= _ sh.Cells(Rows.Count, 1).End(xlUp)(2) End If End If Next If lngCol 0 Then sh.Cells(1, 1).EntireColumn.Delete Else sh.Cells(1, 1).EntireRow.Delete End If End Sub if you have formulas on your sheets, you probably want to paste values rather than do a straight paste: Sub Summarize1() Dim rng As Range, rng1 As Range Dim sh As Worksheet, sh1 As Worksheet Dim lngCol As Long, lngRow As Long On Error Resume Next Set rng = Application.InputBox("Select entirerow or entire column", Type:=8) Set sh1 = Worksheets("Summary") On Error GoTo 0 If rng.Rows.Count 1 Then lngCol = rng.Column Else lngRow = rng.Row End If If Not sh1 Is Nothing Then Application.DisplayAlerts = False sh1.Delete Application.DisplayAlerts = True End If Set sh = Worksheets.Add(Befo=Worksheets(1)) sh.Name = "Summary" For Each sh1 In ActiveWorkbook.Worksheets If sh1.Name < "Summary" Then If lngCol 0 Then sh1.Columns(lngCol).Copy With sh.Cells(1, "IV").End(xlToLeft)(1, 2) .PasteSpecial xlValues .PasteSpecial xlFormats End With Else sh1.Rows(lngRow).Copy With sh.Cells(Rows.Count, 1).End(xlUp)(2) .PasteSpecial xlValues .PasteSpecial xlFormats End With End If End If Next If lngCol 0 Then sh.Cells(1, 1).EntireColumn.Delete Else sh.Cells(1, 1).EntireRow.Delete End If End Sub -- Regards, Tom Ogilvy ali wrote in message ... Hi everyone, I've been trying to solve this for a while but its got me tearing my hair out!!! I want to create a macro that when run will summarise columns or rows from different worksheets and return them to a new sheet that is inserted at the front of the workbook. In an ideal world the macro would bring up a box that would ask for the rows or columns to be summarised. I would then enter the required rows/columns ie, column a, click on ok and every column a in all the worksheets would be returned to a new sheet at the front of the book. ie if there are 3 sheets, column a of sheet 1 would be returned to column a of new sheet, column a of sheet 2 would be returned to column b of new sheet... etc to allow comparison. I appreciate this is in all likelihood a large query but if anyone can help in any way i'd be very grateful! ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~View and post usenet messages directly from http://www.ExcelForum.com/ ~~Now Available: Financial Statements.xls, a step by step guide to creating financial statements |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
This One Is Tricky Need Help !!!!! | Excel Discussion (Misc queries) | |||
A Tricky One...... | Excel Worksheet Functions | |||
This might be a little tricky...... | Excel Discussion (Misc queries) | |||
Is it just me or is this tricky? | Excel Discussion (Misc queries) | |||
Tricky maybe | Excel Worksheet Functions |