Excel -Looking to use VBA to build a table of contents with extra cells copied - excel

Question

I have a good basic script that returns me the sheet name of each sheet in the workbook, but now I'd like to add the contents of cell A1, A2, A3, and A4 into columns B, C, D, and E and add a header row with "Link, Variable, Definition, Calculation, Notes" in columns A, B, C, D. The existing hyperlink will be in column A.
It will need to loop through the entire workbook, and if possible skip adding a link to the table of contents page. Here is a basic script I currently use (borrowed from Extend Office) -
'updateby Extendoffice 20180413
Dim xAlerts As Boolean
Dim I As Long
Dim xShtIndex As Worksheet
Dim xSht As Variant
xAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Table of contents").Delete
On Error GoTo 0
Set xShtIndex = Sheets.Add(Sheets(1))
xShtIndex.Name = "Table of contents"
I = 1
Cells(1, 1).Value = "Table of contents"
For Each xSht In ThisWorkbook.Sheets
If xSht.Name <> "Table of contents" Then
I = I + 1
xShtIndex.Hyperlinks.Add Cells(I, 1), "", "'" & xSht.Name & "'!A1", , xSht.Name
End If
Next
Application.DisplayAlerts = xAlerts
End Sub

Answer 1

Not sure if this does exactly what you want, there is some gaps in the explanation in regards how you want to handle the link fucntion. Since you mention the code "works" but you want some added function, and you dont want links on the "table of contents" but it doesn't do that now either?
anyway give this a go...
Private Sub CommandButton1_Click()
Dim xAlerts As Boolean
Dim I As Long
Dim xShtIndex As Worksheet
Dim Table As Worksheet
Dim xSht As Variant
xAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Table of contents").Delete
On Error GoTo 0
Set xShtIndex = Sheets.Add(Sheets(1))
xShtIndex.Name = "Table of contents"
Set Table = Worksheets("Table of contents")
I = 2
targetcolumn = 1
'Cells(1, 1).Value = "Table of contents"
'Disabled this because i'm not sure if this code should be here?
For Each xSht In ThisWorkbook.Sheets
With xSht
If xSht.Name = "Table of contents" Then
.Cells(1, 1).Value = "Table of contents"
.Range("A1").Value = "Link"
.Range("B1").Value = "Variable"
.Range("C1").Value = "Definition"
.Range("D1").Value = "Calculation"
.Range("E1").Value = "Notes"
End If
If xSht.Name <> "Table of contents" Then
lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Dim copyrng As Range
Set copyrng = .Range("A1:A" & lrow)
copycount = 2 'skipping one because with 1 it would write to row 1 which is where the headers are
For Each cell In copyrng
Table.Cells(targetcolumn, copycount).Value = cell.Value
copycount = copycount + 1
Next
Table.Hyperlinks.Add Table.Cells(I, 1), "", "'" & xSht.Name & "'!A1", , xSht.Name
I = I + 1
End If
End With
targetcolumn = targetcolumn + 1
Next
Application.DisplayAlerts = xAlerts
End Sub