Question

我正在运行以下宏来将来自多个工作表的列数据合并到同一工作簿中的一个工作表中（到一列中）。工作簿的Nmae- ThisWorkbooks

Public Sub Test()

 Dim lRow As Long
 Dim sh As Worksheet
 Dim shArc As Worksheet

 Set shArc = ThisWorkbooks.Worksheets("Archive")
 For Each sh In ThisWorkbooks.Worksheets
     Select Case sh.Name
         Case Is <> "Archive"
             lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row
             sh.Range("A1:A1000").Copy _
                 Destination:=shArc.Range("A" & lRow + 1)
     End Select
 Next

 Set shArc = Nothing
 Set sh = Nothing

 End Sub

你可以告诉我这里一定有什么问题。

Answer 1

它是ThisWorkbook，而不是ThisWorkbooks。

将s放在最后，你应该好好去。

修改：我看到您将ThisWorkbook模块重命名为ThisWorkbooks？如果是这种情况 - 上面应该运行得很好，除非你没有书中带有选项卡名称“Archive”的工作表。

Answer 2

尝试下面的代码，在模块顶部添加Option Explicit可以帮助您检测拼写错误）

Option Explicit

' rest of your code, bla bla bla

' your loop (I like using the `With` inside)
For Each sh In ThisWorkbook.Worksheets
    With sh
        Select Case .Name
            Case Is <> "Archive"
                lRow = shArc.Range("A" & shArc.Rows.Count).End(xlUp).Row
                .Range("A1:A1000").Copy Destination:=shArc.Range("A" & lRow + 1)
        End Select
    End With
Next

Answer 3

以下代码有效。我将我的Excel文件重命名为“Workbook”并应用了下面的逻辑。

Public Sub Test()
     Dim lRow As Long
     Dim sh As Worksheet
     Dim shArc As Worksheet
     Set shArc = ThisWorkbook.Worksheets("Archive")
     For Each sh In ThisWorkbook.Worksheets
         Select Case sh.Name
             Case Is <> "Archive"
                 lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row
                 sh.Range("A1:A2000").Copy _
                     Destination:=shArc.Range("A" & lRow + 1)
         End Select
     Next
     Set shArc = Nothing
     Set sh = Nothing
 End Sub

如果你看到，即使我试图找到一个问题的答案，这是如何工作的？

VBA excell运行时错误424对象未找到

3 个答案: