在ListObject表格列中创build所有表格的索引列表及其名称

我想创build一个索引列表的所有工作表与他们的名字在列表中。

到目前为止，我已经写了下面的代码，但是它在引用的行上给出了一个错误。

Dim ws As Worksheet, tbl As ListObject, i As Integer Set ws = Sheets("Profile Management") Set tbl = ws.ListObjects("sheets") With tbl.ListRows Do While .Count >= 1 .Item(1).Delete Loop End With For i = 1 To Sheets.Count "tbl.ListColumns(1).DataBodyRange = Sheets(i).Name" Next I 

我哪里去错了？

Answer 1

使用结构化（又名ListObject ）表为VBA带来了一些额外的问题。 您不能以这种方式写入.DataBodyRange属性 ，而.DataBodyRane是ListObject的成员，而不是ListObject的ListColumns属性 。

 Option Explicit Sub wqwe() Dim tbl As ListObject, i As Long, w As Long With Worksheets("Profile Management") With .ListObjects("sheets") 'make sure there is at least 1 row in the databodyrange If .DataBodyRange Is Nothing Then _ .ListRows.Add 'clear the first column .DataBodyRange.Columns(1).ClearContents 'insert the worksheet names For w = 1 To Worksheets.Count 'except "Profile Management" If Worksheets(w).Name <> .Parent.Name Then i = i + 1 'expand the table for new worksheets .DataBodyRange.Cells(i, 1) = Worksheets(w).Name 'optionally insert a hyperlink to each worksheet's A1 .Parent.Hyperlinks.Add Anchor:=.DataBodyRange.Cells(i, 1), _ Address:=vbNullString, SubAddress:=Worksheets(w).Name & "!A1", _ TextToDisplay:=Worksheets(w).Name, ScreenTip:="click to go there" End If Next w 'reshape the table if there are blank rows Do While i < .ListRows.Count .ListRows(i + 1).Delete Loop End With End With End Sub 

正如在上面的评论中指出的，我已经添加了选项，直接从表中的列表中链接到每个工作表。 如果您select此路线，则不必先将名称放入表格单元格中。

Answer 2

以下更简单。

  Sub GetWorksheetNames() Dim i As Long ThisWorkbook.Worksheets("Profile Management").Cells(1, 1).Value = "Worksheet Inventory" For i = 1 To ThisWorkbook.Worksheets.Count ThisWorkbook.Worksheets("Profile Management").Cells(i + 1, 1).Value = ThisWorkbook.Worksheets(i).Name Next i End Sub