Mmm tricky- but i'm sure someone out there can help!

  • Thread starter Thread starter ali
  • Start date Start date
A

ali

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!
 
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(Before:=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(Before:=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 said:
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!


------------------------------------------------



~~Now Available: Financial Statements.xls, a step by step guide to
Click to expand...
creating financial statements
 
Back
Top