A
al007
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 cells??
For Each Sh In ActiveWindow.SelectedSheets
(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 for any help !!
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 cells??
For Each Sh In ActiveWindow.SelectedSheets
(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 for any help !!