在列中複製工作表名稱（來自循環代碼）

Question

有人可以幫助我。

有以下代碼堆棧從倍數工作表中的信息爲一個（「數據庫」） - （環路）

它是不工作的唯一的事情是最後行動的工作周的名字複製的「數據庫「列」Aw「。

宏不會帶來任何錯誤，但工作表名稱沒有出現在列「AW」

什麼建議嗎？

Sub Update() 
' Update Templates 
    Dim All As Worksheet 
    Dim J As Integer 
    Dim Last As Long 
    Dim CopyRng As Range 

    Application.ScreenUpdating = False 

    ' Update Consol 
    On Error Resume Next 

    Sheets("Database").Select 
    Range("A2:AL1048576").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Clear 

    For J = 6 To Sheets.Count 
     Sheets(J).Activate 
     Range("A2:AL2").Select 
     Range(Selection, Selection.End(xlDown)).Select 
     Selection.Copy 

     With Sheets("Database").Range("A1048576").End(xlUp)(2) 
      .PasteSpecial xlPasteValues 

      Database.Cells(Last + 1, "AW").Resize(CopyRng.Rows.Count).Value = All.Name 

     End With 

    Next 

End Sub 

Answer 1

試試這個（我刪除了所有的選項，因爲他們似乎沒有必要）：

Sub Update() 
'Update Templates 
Dim All As String 
Dim j As Integer 
Dim Last As Long 'Missing value 
Dim CopyRng As Long 'No need for Range in this Sub 

Application.ScreenUpdating = False 

' Update Consol 
On Error Resume Next 

With ActiveWorkbook 'modify 
For j = 6 To .Sheets.Count 
    .Sheets(j).Range("A2:AL" & _ 
    .Sheets(j).Range("A2:AL2").End(xlDown).Row).Copy 
CopyRng = .Sheets(j).Range("A2:AL2").End(xlDown).Row - 1 
All = .Sheets(j).Name 
End With 

    With .Sheets("Database").Range("A1048576").End(xlUp)(2) 
     .PasteSpecial xlPasteValues 

'EDIT: 
     debug.print All 'check immediate window for correct string 
     .Sheets("Database").Cells(Last + 1, _ 
     "AW").Value = All 
'  .Sheets("Database").Cells(Last + 1, _ 
'  "AW").Resize(CopyRng).Value = All 
    End With 

Next 

End Sub 

不知道什麼是「最後」 var是，所以不要忘記來解決它在運行代碼之前。希望這可以幫助。