Lost in code
 

I'm trying to creat a macro which will copy and paste the value of a cell
(say G12 on a series of worksheets) to a newly created sheet "Summary". The
code (so far) is below, but far short of what I want to acheive. Can someone
help me?


Sub GetMyCellValues()
Dim ws As Worksheet
Dim myCell As String
i = 1
myCell = Application.InputBox("Enter Cell Reference")
Sheets.Add
ActiveSheet.Name = "Summary"
For Each ws In Worksheets
Worksheets(ws.Name).Select
'Worksheets(ws.Name).Range("a4").Select
Worksheets(ws.Name).Range(myCell).Copy _
Destination:=Worksheets("Summary").Cells(i, 2)
Worksheets("Summary").Cells(i, 1) = ws.Name
i = i + 1
Next ws
End Sub

Lost in code
 

One way:

Option Explicit
Sub GetMyCellValues()
Dim RptWks As Worksheet
Dim ws As Worksheet
Dim myCell As Range
Dim i As Long

Set myCell = Nothing
On Error Resume Next
Set myCell = Application.InputBox("Click on the cell to use", _
Type:=8).Cells(1)
On Error GoTo 0

If myCell Is Nothing Then
'user hit cancel
Exit Sub
End If

Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Summary").Delete
On Error GoTo 0
Application.DisplayAlerts = True


Set RptWks = Worksheets.Add
RptWks.Name = "Summary"

i = 1
For Each ws In Worksheets
If ws.Name = RptWks.Name Then
'skip it
Else
ws.Range(myCell.Address).Copy _
Destination:=RptWks.Cells(i, 2)
RptWks.Cells(i, 1).Value = "'" & ws.Name
i = i + 1
End If
Next ws
End Sub

But instead of typing the address, application.inputbox with type:=8 allows you
to click on the cell to use.

If you have formulas, you may want to paste special|values, too:

ws.Range(myCell.Address).Copy _
Destination:=RptWks.Cells(i, 2)

becomes

ws.Range(myCell.Address).Copy
RptWks.Cells(i, 2).pastespecial paste:=xlpastevalues

or
rptwks.cells(i,2).value = ws.range(mycell.address).value

(You may want to worry about the numberformat, too.)

Jim May wrote:

I'm trying to creat a macro which will copy and paste the value of a cell
(say G12 on a series of worksheets) to a newly created sheet "Summary". The
code (so far) is below, but far short of what I want to acheive. Can someone
help me?

Sub GetMyCellValues()
Dim ws As Worksheet
Dim myCell As String
i = 1
myCell = Application.InputBox("Enter Cell Reference")
Sheets.Add
ActiveSheet.Name = "Summary"
For Each ws In Worksheets
Worksheets(ws.Name).Select
'Worksheets(ws.Name).Range("a4").Select
Worksheets(ws.Name).Range(myCell).Copy _
Destination:=Worksheets("Summary").Cells(i, 2)
Worksheets("Summary").Cells(i, 1) = ws.Name
i = i + 1
Next ws
End Sub

--

Dave Peterson

Lost in code
 

Hi Jim
Here is another example
Im sure that Dave's code works fine.
just trying to show there is many way's to do the same job
Remember u dont have to Select/Activate a Sheet to copy from it
(it slow's your code)
good luck and go for it :-)

Sub Sumary()

Dim myCell As String
Dim ws As Integer

On Error GoTo wsAdd
Sheets("Summary").Select
myCell = Application.InputBox("Cells to copy ?", Type:=8).Address

For ws = 1 To Sheets.Count - 1
Cells(ws, 1) = Sheets(ws).Name
Cells(ws, 2) = Sheets(ws).Range(myCell)
Next

GoTo finish
wsAdd:
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Summary"
On Error GoTo 0
Resume Next
finish:
End Sub



"Jim May" skrev:

I'm trying to creat a macro which will copy and paste the value of a cell
(say G12 on a series of worksheets) to a newly created sheet "Summary". The
code (so far) is below, but far short of what I want to acheive. Can someone
help me?


Sub GetMyCellValues()
Dim ws As Worksheet
Dim myCell As String
i = 1
myCell = Application.InputBox("Enter Cell Reference")
Sheets.Add
ActiveSheet.Name = "Summary"
For Each ws In Worksheets
Worksheets(ws.Name).Select
'Worksheets(ws.Name).Range("a4").Select
Worksheets(ws.Name).Range(myCell).Copy _
Destination:=Worksheets("Summary").Cells(i, 2)
Worksheets("Summary").Cells(i, 1) = ws.Name
i = i + 1
Next ws
End Sub

Lost in code
 

Much appreciated Dave,
Will study in detail...
Jim

"Dave Peterson" wrote:

One way:

Option Explicit
Sub GetMyCellValues()
Dim RptWks As Worksheet
Dim ws As Worksheet
Dim myCell As Range
Dim i As Long

Set myCell = Nothing
On Error Resume Next
Set myCell = Application.InputBox("Click on the cell to use", _
Type:=8).Cells(1)
On Error GoTo 0

If myCell Is Nothing Then
'user hit cancel
Exit Sub
End If

Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Summary").Delete
On Error GoTo 0
Application.DisplayAlerts = True


Set RptWks = Worksheets.Add
RptWks.Name = "Summary"

i = 1
For Each ws In Worksheets
If ws.Name = RptWks.Name Then
'skip it
Else
ws.Range(myCell.Address).Copy _
Destination:=RptWks.Cells(i, 2)
RptWks.Cells(i, 1).Value = "'" & ws.Name
i = i + 1
End If
Next ws
End Sub

But instead of typing the address, application.inputbox with type:=8 allows you
to click on the cell to use.

If you have formulas, you may want to paste special|values, too:

ws.Range(myCell.Address).Copy _
Destination:=RptWks.Cells(i, 2)

becomes

ws.Range(myCell.Address).Copy
RptWks.Cells(i, 2).pastespecial paste:=xlpastevalues

or
rptwks.cells(i,2).value = ws.range(mycell.address).value

(You may want to worry about the numberformat, too.)

Jim May wrote:

I'm trying to creat a macro which will copy and paste the value of a cell
(say G12 on a series of worksheets) to a newly created sheet "Summary". The
code (so far) is below, but far short of what I want to acheive. Can someone
help me?

Sub GetMyCellValues()
Dim ws As Worksheet
Dim myCell As String
i = 1
myCell = Application.InputBox("Enter Cell Reference")
Sheets.Add
ActiveSheet.Name = "Summary"
For Each ws In Worksheets
Worksheets(ws.Name).Select
'Worksheets(ws.Name).Range("a4").Select
Worksheets(ws.Name).Range(myCell).Copy _
Destination:=Worksheets("Summary").Cells(i, 2)
Worksheets("Summary").Cells(i, 1) = ws.Name
i = i + 1
Next ws
End Sub

--

Dave Peterson

Lost in code
 

thanks excelent,
Great code!
Jim

"excelent" wrote:

Hi Jim
Here is another example
Im sure that Dave's code works fine.
just trying to show there is many way's to do the same job
Remember u dont have to Select/Activate a Sheet to copy from it
(it slow's your code)
good luck and go for it :-)

Sub Sumary()

Dim myCell As String
Dim ws As Integer

On Error GoTo wsAdd
Sheets("Summary").Select
myCell = Application.InputBox("Cells to copy ?", Type:=8).Address

For ws = 1 To Sheets.Count - 1
Cells(ws, 1) = Sheets(ws).Name
Cells(ws, 2) = Sheets(ws).Range(myCell)
Next

GoTo finish
wsAdd:
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Summary"
On Error GoTo 0
Resume Next
finish:
End Sub



"Jim May" skrev:

I'm trying to creat a macro which will copy and paste the value of a cell
(say G12 on a series of worksheets) to a newly created sheet "Summary". The
code (so far) is below, but far short of what I want to acheive. Can someone
help me?


Sub GetMyCellValues()
Dim ws As Worksheet
Dim myCell As String
i = 1
myCell = Application.InputBox("Enter Cell Reference")
Sheets.Add
ActiveSheet.Name = "Summary"
For Each ws In Worksheets
Worksheets(ws.Name).Select
'Worksheets(ws.Name).Range("a4").Select
Worksheets(ws.Name).Range(myCell).Copy _
Destination:=Worksheets("Summary").Cells(i, 2)
Worksheets("Summary").Cells(i, 1) = ws.Name
i = i + 1
Next ws
End Sub