View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default 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