View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
al007 al007 is offline
external usenet poster
 
Posts: 118
Default Summary All Worksheets With links

Hi Ron,
Thxs for your prompt reply - but I did not expect all selected row of a
sheet to be summarised in only 1 row in the summary sheet.
I wanted it in individual row
e,if my selected sheets are sheet1 & sheet2 & range being A1:C3
i would expect data as follows:
=Sheet1!A1 =Sheet1!B1 =Sheet1!C1
=Sheet1!A2 =Sheet1!B2 =Sheet1!C2
=Sheet1!A3 =Sheet1!B3 =Sheet1!C3
=Sheet2!A1 =Sheet2!B1 =Sheet2!C1
=Sheet2!A2 =Sheet2!B2 =Sheet2!C2
=Sheet2!A3 =Sheet2!B3 =Sheet2!C3

can you help pls

thxs







Ron de Bruin wrote:
Hi

I don not like the way you want to do this with selecting more then one sheet but OK

Note: Copy also the function in the module

It will use this sheet
Set Destsh = Sheets("Summary-Sheet")

Select the cells you want before you run the macro
Then select the sheets you want and run the macro
Every time you run the macro it will add the links below the last line

Note : not more then 256 cells

Sub Summary_All_Worksheets_With_Formulas_Test()
Dim sh As Worksheet
Dim Destsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook
Dim rngaddr As String

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set Basebook = ThisWorkbook
Set Destsh = Sheets("Summary-Sheet")

rngaddr = Selection.Address(False, False)


RwNum = LastRow(Destsh) + 1
'The links to the first sheet will start in the first empty row

For Each sh In ActiveWindow.SelectedSheets
ColNum = 1
RwNum = RwNum + 1

Destsh.Cells(RwNum, 1).Value = sh.Name
'Copy the sheet name in the A column

For Each myCell In sh.Range(rngaddr)
ColNum = ColNum + 1
Destsh.Cells(RwNum, ColNum).Formula = _
"='" & sh.Name & "'!" & myCell.Address(False, False)
Next myCell
Next sh

Destsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub


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

--
Regards Ron de Bruin
http://www.rondebruin.nl


"al007" wrote in message ups.com...
I want to create links to the cells & range can be continuous or non
continuous.
& as per previous post
(3) Allow me to put the range to be copied in an existing sheet
(instead of a new sheet) with a messge box to enter the first cell
where it would start - as I need to run macro for several times on
different range

thxs