Reference Same Cell From Multiple Worksheets With VBA Code & Paste it as a

The VBA code below: reference same cell from multiple worksheets.However, How can I modify the code reference to copy "50 worksheets", that has values in both "F2 & G2"and paste the same values into a new workbook as a list on "C2 & D2" downwards"

Here is the code to be modify:

Sub AutoFillSheetNames()

'Update 20131202

Dim ActRng As Range

Dim ActWsName As String

Dim ActAddress As String

Dim Ws As Worksheet

On Error Resume Next

xTitleId = "KutoolsforExcel"

Set ActRng = Application.ActiveCell

ActWsName = Application.ActiveSheet.Name

ActAddress = ActRng.Address(False, False)

Application.ScreenUpdating = False

xIndex = 0

For Each Ws In Application.Worksheets

If Ws.Name <> ActWsName Then

ActRng.Offset(xIndex, 0).Value = "='" & Ws.Name & "'!" & ActAddress

xIndex = xIndex + 1

End If

Next

Application.ScreenUpdating = True

End Sub

Bonjour,

essai en remplaçant

ActRng.Offset(xIndex, 0).Value = "='" & Ws.Name & "'!" & ActAddress

par

ActRng.Offset(xIndex, 0).Value = "=!" & ActAddress

Hello. I have replace the code. Nothing happen.

What do you want me to do?

J'ai rien compris mais essaie comme ca

Sub AutoFillSheetNames()
'Update 20131202
Dim ActRng As Range
Dim ActWsName As String
Dim ActAddress As String
Dim Ws As Worksheet, nws As Worksheet
Dim LastRow As Long
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set ActRng = Application.ActiveCell
ActWsName = Application.ActiveSheet.Name
ActAddress = ActRng.Address(False, False)
Application.ScreenUpdating = False
ThisWorkbook.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "NewWorkbook"
Set nws = Sheets("NewWorkbook")
nws.Range("C1").Value = "Values ..."
xIndex = 0
For Each Ws In Application.Worksheets
If Ws.Name <> ActWsName Then
ActRng.Offset(xIndex, 0).Value = "='" & Ws.Name & "'!" & ActAddress
xIndex = xIndex + 1
If Application.WorksheetFunction.CountA(Ws.Range("F2:G2")) = 2 Then
LastRow = nws.Cells(nws.Rows.Count, "C").End(xlUp).Row + 1
Ws.Range("F2:G2").Copy nws.Range("C" & LastRow)
End If
End If
Next
Application.ScreenUpdating = True
End Sub

I am stuck. I don't know what to do.

I am not sure if you can help me.

My problem here is this.

I want to extract data from 50 worksheets that have it values in cells "F2 &G2" the name of the workbook is: "Countries Indicators #1 NSB (1)"

Next

I want to paste and lockALL data, "F2 & G2" cells as a list into next workbook name: "Anton Heatwave" in "C2 & D2" respectively.

Please see files below

à tester

Sub test()
Dim wbd As Workbook, wbs As Workbook
Dim sh As Worksheet
Dim RngRatedate As Range, RngRate As Range
Dim Lastrow As Long

Set wbd = Workbooks("Anton Heatwave.xlsm")
Set sh = wbd.Sheets("Heat Map ")

On Error Resume Next
Set wbs = Workbooks("Countries Indicators #1 NSB (1).xlsm")
On Error GoTo 0

If wbs Is Nothing Then
    Set wbs = Workbooks.Open("C:\Users\Corey\Desktop\Anton Heatwave\PMI\Countries Indicators #1 NSB (1).xlsm")
End If

wbd.Activate

Lastrow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row

For i = 2 To Lastrow
sh.Range("C" & i).Value = wbs.Sheets(Range("A" & i).Value).Range("F2").Value
sh.Range("D" & i).Value = wbs.Sheets(Range("A" & i).Value).Range("G2").Value
Next i

wbs.Close False

End Sub

It's working. It's working. It's working.

Thank you, Thank you & Thank you very much

Greatly appreciate your patience and support

Thank you