Question

有人可以帮助我。

使用以下代码将多个工作表中的信息堆叠成一个（＆＃34;数据库＆＃34;） - （循环）

唯一不起作用的是在＆＃34;数据库＆＃34;中复制工作周名称的最后一项操作。专栏＆＃34; Aw＆＃34;。

宏不会带来任何错误，但是表格名称不会出现在＆＃34; AW＆＃34;

列中

有什么建议吗？

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

不知道＆＃39;最后＆＃39; var代表，所以在运行代码之前不要忘记解决它。希望这可以帮助。

在列中复制工作表名称（从循环代码中）

1 个答案: