Reference A2 cell in individual sheets Vba Script

[tek9step]

I have below Vba Script where all the name of individual sheet get transfered in A column of new sheet called " Sheet Names" which is fine but what I would like to add to the script is all the A2 reference appearing in those indivual sheets also appearing in B column next to individual sheet names in sheet "Sheet Names".

Sub ListSheetNames()

Dim NumSheets
NumSheets = Sheets.Count

Application.DisplayAlerts = False
Dim i
For i = 1 To NumSheets
Sheets(i).Select
If ActiveSheet.Name = "SheetNames" Then
Sheets("SheetNames").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Exit Sub
End If
Next i

Sheets.Add
ActiveSheet.Name = "SheetNames"
Sheets("SheetNames").Move after:=Sheets(NumSheets + 1)

For i = 1 To NumSheets
Range("A" & i) = Sheets(i).Name
Next i

End Sub

Thank you

[DonkeyOte]

Something along the lines of the below perhaps ?

Public Sub ListSheetNames()
Dim i As Long, ws As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Sheets("SheetNames").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add After:=Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = "SheetNames"
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> ActiveSheet.Name Then
        i = i + 1
        Cells(i, 1) = ws.Name
        Cells(i, 2) = ws.Cells(2, "A")
    End If
Next ws
End Sub

[tek9step]

Cheers it works perfect.. !!