Lost in code

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

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
 
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.)
 
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:
 
thanks excelent,
Great code!
Jim

excelent said:
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:
Click to expand...
 
Back
Top