[已解决]如何在工作表"目录"中列出每20行的工作表名称?

森林木007

各位大师:
       新年好!
       我在网上下载了一个可以在A列列出序号,B列给出工作表名称,但超过20个工作表读入不是很方便.我想实现每20个工作表名称在目录中的A:B中大于20个排列在C:D...中,不知如何修改.请大师出手.谢谢!!!!
Private Sub CommandButton1_Click()
Application.DisplayAlerts = False
Sheets("目录").Delete
Application.DisplayAlerts = True
Set 目录sheet = Sheets.add(before:=Worksheets(1), Type:=xlWorksheet)
Sheets(1).Name = "目录"
目录sheet.Cells(1, 1) = "工作表目录"
目录sheet.Range("A1:B1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Selection.Merge
For i = 2 To Sheets.Count
目录sheet.Cells(i, 1).Value = i - 1
目录sheet.Cells(i, 2).Value = Sheets(i).Name
目录sheet.Cells(i, 2).Select
ActiveSheet.Hyperlinks.add Anchor:=Selection, Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1"
Next i
目录sheet.Range("A2").Select
目录sheet.Range(Selection, Selection.End(xlDown)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
   目录sheet.Columns("A:B").Select
   目录sheet.Range("A2").Activate
   目录sheet.Columns("A:B").EntireColumn.AutoFit
End Sub

最佳答案

月排行榜 / 总排行榜

suye1010

2013-2-23 18:25

1. Private Sub CommandButton1_Click()
   
2. Application.DisplayAlerts = False
   
3. Sheets("目录").Delete
   
4. Application.DisplayAlerts = True
   
5. Set 目录sheet = Sheets.add(before:=Worksheets(1), Type:=xlWorksheet)
   
6. Sheets(1).Name = "目录"
   
7. 目录sheet.Cells(1, 1) = "工作表目录"
   
8. 目录sheet.Range("A1:B1").Select
   
9.     With Selection
   
10.         .HorizontalAlignment = xlCenter
    
11.         .VerticalAlignment = xlCenter
    
12.     End With
    
13.     Selection.Merge
    
14. For i = 2 To Sheets.Count
    
15. 目录sheet.Cells(((i-2) mod 20)+3, 1+((i-2)\20)*2).Value = i - 1
    
16. 目录sheet.Cells(((i-2) mod 20)+3, 2+((i-2)\20)*2).Value = Sheets(i).Name
    
17. 目录sheet.Cells(((i-2) mod 20)+3, 2+((i-2)\20)*2).Select
    
18. ActiveSheet.Hyperlinks.add Anchor:=Selection, Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1"
    
19. Next i
    
20. 目录sheet.Range("A2").Select
    
21. 目录sheet.Range(Selection, Selection.End(xlDown)).Select
    
22.     With Selection
    
23.         .HorizontalAlignment = xlCenter
    
24.         .VerticalAlignment = xlCenter
    
25.     End With
    
26.    目录sheet.Columns("A:B").Select
    
27.    目录sheet.Range("A2").Activate
    
28.    目录sheet.Columns("A:B").EntireColumn.AutoFit
    
29. End Sub

复制代码

跳转到最佳答案楼层

suye1010

1. Private Sub CommandButton1_Click()
   
2. Application.DisplayAlerts = False
   
3. Sheets("目录").Delete
   
4. Application.DisplayAlerts = True
   
5. Set 目录sheet = Sheets.add(before:=Worksheets(1), Type:=xlWorksheet)
   
6. Sheets(1).Name = "目录"
   
7. 目录sheet.Cells(1, 1) = "工作表目录"
   
8. 目录sheet.Range("A1:B1").Select
   
9.     With Selection
   
10.         .HorizontalAlignment = xlCenter
    
11.         .VerticalAlignment = xlCenter
    
12.     End With
    
13.     Selection.Merge
    
14. For i = 2 To Sheets.Count
    
15. 目录sheet.Cells(((i-2) mod 20)+3, 1+((i-2)\20)*2).Value = i - 1
    
16. 目录sheet.Cells(((i-2) mod 20)+3, 2+((i-2)\20)*2).Value = Sheets(i).Name
    
17. 目录sheet.Cells(((i-2) mod 20)+3, 2+((i-2)\20)*2).Select
    
18. ActiveSheet.Hyperlinks.add Anchor:=Selection, Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1"
    
19. Next i
    
20. 目录sheet.Range("A2").Select
    
21. 目录sheet.Range(Selection, Selection.End(xlDown)).Select
    
22.     With Selection
    
23.         .HorizontalAlignment = xlCenter
    
24.         .VerticalAlignment = xlCenter
    
25.     End With
    
26.    目录sheet.Columns("A:B").Select
    
27.    目录sheet.Range("A2").Activate
    
28.    目录sheet.Columns("A:B").EntireColumn.AutoFit
    
29. End Sub

复制代码

森林木007

suye1010 发表于 2013-2-23 18:25

版主你好!
谢谢你的回帖,请看附件效果,不知能否实现,谢谢!
增加工作表名称每20个一列.zip (15.37 KB, 下载次数: 3)

2013-2-23 18:42 上传

点击文件名下载附件