[發問] 取工作表名稱再覆制多次

missbb

工作部有20張SHEETS, 由第7張至最後一張的SHEET名稱, 放在AA檔之F1起, 每個SHEET名稱COPY 20次. 而E1顯示1,2,3,4,....20 , 我寫了下列, 只可以出現最後一張工作表, 請教錯誤在那?

1 工作表名1
2 工作表名1
3 工作表名1
4 工作表名1
...20 工作表名1

1 工作表名2
2 工作表名2
3 工作表名2
4工作表名2
...20 工作表名2

1. Sub getSheetName()
   
2. 
   
3.     Dim i As Integer
   
4.     Dim shtname As Integer
   
5.    
   
6.     Worksheets("aa").Select
   
7.     Range("B1").CurrentRegion.Clear
   
8.    
   
9.     Range("B1").Select
   
10.    
    
11.     For i = 7 To Worksheets.Count
    
12.     Range("B1").Resize(20) = Worksheets(i).Name
    
13.    
    
14.               
    
15.     Next i
    
16.    
    
17. End Sub

複製代碼

ikboy

你的代碼重覆填在Sheets("aa").Range("B1").Resize(20)
當然衹會見到最後一頁的頁名, 另外由7~最後一頁的頁名都是數字?

missbb

回復 2# ikboy


    是英文加數字, 但1-6張SHEET是不用處理的.有勞!

lpk187

回復 3# missbb



循環需要再加上一個變數

1. Sub getSheetName()
   
2. 
   
3.     Dim i As Integer
   
4.     Dim shtname As Integer
   
5.    
   
6.     Worksheets("aa").Select
   
7.     Range("B1").CurrentRegion.Clear
   
8.    
   
9.     Range("B1").Select
   
10.     n = 1
    
11.     For i = 7 To Worksheets.Count
    
12.    
    
13.     Range("B" & n).Resize(20) = Worksheets(i).Name
    
14.     n = n + 20
    
15.     Next i
    
16.    
    
17. End Sub

複製代碼

ikboy

我有點奇怪,為甚麼missbb先進有過一句 Dim shtname As Integer, 是不是還有後期引用 sheets.name ?
但宣告成整數!

missbb

回復 4# lpk187


    如何在A1加上1,2,3.....20, 再重複?
有勞

ikboy

for i = 你的下標 to  你的上標
  for j = 1 to 20
    [a1]=join([a1], 你的物件)
      next i,j

missbb

回復 7# ikboy

多謝指導! :D

missbb

回復 4# lpk187

多謝指導! :D

n7822123

1. Sub getSheetName()
   
2. 
   
3. Dim i As Integer
   
4. Dim shtname As Integer
   
5. 
   
6. Worksheets("aa").Select
   
7. Range("B1").CurrentRegion.Clear
   
8. 
   
9. Range("B1").Select
   
10. 
    
11. n = 1
    
12. 
    
13. For i = 7 To Worksheets.Count
    
14. 
    
15.   Range("B" & n).Resize(20) = Worksheets(i).Name
    
16. 
    
17.   For j = 1 To 20
    
18.     Range("A" & n) = j
    
19.     n = n + 1
    
20.   Next j
    
21. Next i
    
22.    
    
23. End Sub

複製代碼

請收下，:D