Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Summary All Worksheets With links
Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet Dim Newsh As Worksheet Dim myCell As Range Dim ColNum As Integer Dim RwNum As Long Dim Basebook As Workbook With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With Set Basebook = ThisWorkbook Set Newsh = Basebook.Worksheets.Add On Error Resume Next Newsh.Name = "Summary-Sheet" If Err.Number 0 Then MsgBox "The Summary sheet already exist in this workbook." With Application .DisplayAlerts = False Newsh.Delete .DisplayAlerts = True .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With Exit Sub End If RwNum = 1 'The links to the first sheet will start in row 2 For Each Sh In Basebook.Worksheets If Sh.Name < Newsh.Name And Sh.Visible Then ColNum = 1 RwNum = RwNum + 1 Newsh.Cells(RwNum, 1).Value = Sh.Name 'Copy the sheet name in the A column For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range ColNum = ColNum + 1 Newsh.Cells(RwNum, ColNum).Formula = _ "='" & Sh.Name & "'!" & myCell.Address(False, False) Next myCell End If Next Sh Newsh.UsedRange.Columns.AutoFit With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub Could Ron or another guru tell me how I can amend the above code as follows: (1) Allow me to select the range I want with a message box - where should i put the code below?? myRange = Application.InputBox( _ Prompt:="Select cell for Standard data.", Type:=8) (2) Allow me to select the sheets I want instead of all visible sheets?? (For Each Sh In ActiveWindow.SelectedSheets) thxs |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Summary All Worksheets With links
Hi al007
Do you want to copy data from a few sheets or create links to the cells??? Is the range continuous ? -- Regards Ron de Bruin http://www.rondebruin.nl "al007" wrote in message ups.com... Sub Summary_All_Worksheets_With_Formulas() Dim Sh As Worksheet Dim Newsh As Worksheet Dim myCell As Range Dim ColNum As Integer Dim RwNum As Long Dim Basebook As Workbook With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With Set Basebook = ThisWorkbook Set Newsh = Basebook.Worksheets.Add On Error Resume Next Newsh.Name = "Summary-Sheet" If Err.Number 0 Then MsgBox "The Summary sheet already exist in this workbook." With Application .DisplayAlerts = False Newsh.Delete .DisplayAlerts = True .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With Exit Sub End If RwNum = 1 'The links to the first sheet will start in row 2 For Each Sh In Basebook.Worksheets If Sh.Name < Newsh.Name And Sh.Visible Then ColNum = 1 RwNum = RwNum + 1 Newsh.Cells(RwNum, 1).Value = Sh.Name 'Copy the sheet name in the A column For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range ColNum = ColNum + 1 Newsh.Cells(RwNum, ColNum).Formula = _ "='" & Sh.Name & "'!" & myCell.Address(False, False) Next myCell End If Next Sh Newsh.UsedRange.Columns.AutoFit With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub Could Ron or another guru tell me how I can amend the above code as follows: (1) Allow me to select the range I want with a message box - where should i put the code below?? myRange = Application.InputBox( _ Prompt:="Select cell for Standard data.", Type:=8) (2) Allow me to select the sheets I want instead of all visible sheets?? (For Each Sh In ActiveWindow.SelectedSheets) thxs |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Summary All Worksheets With links
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Summary All Worksheets With links
Hi al007
I look at it after work -- 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Summary All Worksheets With links
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Summary All Worksheets With links
Hi al007
Try this one 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 Dim a As Integer With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With Set Basebook = ThisWorkbook Set Destsh = Sheets("Summary-Sheet") rngaddr = Selection.Address(False, False) For Each sh In ActiveWindow.SelectedSheets For a = 1 To sh.Range(rngaddr).Rows.Count ColNum = 1 RwNum = LastRow(Destsh) + 1 Destsh.Cells(RwNum, 1).Value = sh.Name 'Copy the sheet name in the A column For Each myCell In sh.Range(rngaddr).Rows(a).Cells ColNum = ColNum + 1 Destsh.Cells(RwNum, ColNum).Formula = _ "='" & sh.Name & "'!" & myCell.Address(False, False) Next myCell Next a Next sh Destsh.UsedRange.Columns.AutoFit With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub -- Regards Ron de Bruin http://www.rondebruin.nl "al007" wrote in message ups.com... 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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Summary All Worksheets With links
Perfect!! - Thxs a lot
Take care Ron de Bruin wrote: Hi al007 Try this one 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 Dim a As Integer With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With Set Basebook = ThisWorkbook Set Destsh = Sheets("Summary-Sheet") rngaddr = Selection.Address(False, False) For Each sh In ActiveWindow.SelectedSheets For a = 1 To sh.Range(rngaddr).Rows.Count ColNum = 1 RwNum = LastRow(Destsh) + 1 Destsh.Cells(RwNum, 1).Value = sh.Name 'Copy the sheet name in the A column For Each myCell In sh.Range(rngaddr).Rows(a).Cells ColNum = ColNum + 1 Destsh.Cells(RwNum, ColNum).Formula = _ "='" & sh.Name & "'!" & myCell.Address(False, False) Next myCell Next a Next sh Destsh.UsedRange.Columns.AutoFit With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub -- Regards Ron de Bruin http://www.rondebruin.nl "al007" wrote in message ups.com... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Summary of worksheets | Excel Discussion (Misc queries) | |||
Summary count from different worksheets? | Excel Discussion (Misc queries) | |||
Summary page for 12 worksheets | Excel Discussion (Misc queries) | |||
Viewing Links In a summary? | Excel Discussion (Misc queries) | |||
Summary of all worksheets | Excel Programming |