Hello,
Can any one help me to extract the contents of a cell (Eg. A1 of all sheet) in all sheets of a workbook to a new sheet in the same work book.
Thanks in advance.
:mad:
Hello,
Can any one help me to extract the contents of a cell (Eg. A1 of all sheet) in all sheets of a workbook to a new sheet in the same work book.
Thanks in advance.
:mad:
Hi superexl!
Place the code below in std module,and pleas try this.
Sub ExtractTheContents()
Dim wsRet As Worksheet, ws As Worksheet
Set wsRet = Sheets.Add(after:=Sheets(Sheets.Count))
wsRet.[A1:B1].Value = Array("Value", "Sheet's Name")
For Each ws In Worksheets
If Not ws.Name = wsRet.Name Then
With wsRet.[A65536].End(xlUp).Offset(1)
.Value = ws.[A1].Value 'Suit your needs
.Offset(, 1).Value = ws.Name
End With
End If
Next
End Sub
Display More
Hi colo,
I will try and reply back in an hour or so!! there are more than 60 sheets.
bye
Hi Superexl
Along the same lines as Colo's reply
Sub DoIt()
Dim wSheet As Worksheet
On Error Resume Next
Sheets.Add().Name = "CopySheet"
For Each wSheet In Worksheets
If wSheet.Name <> "CopySheet" Then
wSheet.Range("A1").Copy Destination:= _
Sheets("CopySheet").Range("A65536").End(xlUp)(2, 1)
End If
Next wSheet
On Error GoTo 0
End Sub
Display More
Hi Colo,
I works but every time i change the cell reference it is creating a new sheet. what to do if i want to select a range of cell to be extracted and also if it is a formula?
bye
superexl :o2
Hi Dave Hawley,
The code works but i want to extract some 20 cells in each sheet to a sheet (not a new sheet) I will change the cell ref in code. the code is not working if i change the cell ref and #REF! is comming error as that cell contain formula. Plase help me :question:
Hi superexl
Try this code. It paste the results as Values only and should prevent any #REF! errors
Sub DoIt()
Dim wSheet As Worksheet
For Each wSheet In Worksheets
'Change name of sheet to suit
If wSheet.Name <> "CopySheet" Then
'Change range to suit
wSheet.Range("A1:A20").Copy
'Will only paste the values
Sheets("CopySheet").Range("A65536").PasteSpecial xlValues
Application.CutCopyMode = False
End If
Next wSheet
On Error GoTo 0
End Sub
Display More
Dear Dave,
Thanks for the help. It works superbly!!. & sorry for delayed reply from me! thanks a lot.
superexl.:wink1:
Thanks a lot -- this answers a question I've been getting nowhere with for a while.
BRILLIANT site!
:bouncing:
Don’t have an account yet? Register yourself now and be a part of our community!