Question

好日子朋友，每当我尝试遍历所有打开的工作簿以便复制并粘贴到主工作簿时，我都会收到错误。对于我的生活，我无法弄清楚如何纠正它，你们中的任何人都可以帮助吗？

Sub LoopCopyPaste()
Dim wb As Workbook
Dim Lastrow As Long
    For Each wb In Application.Workbooks
            If wb.Name <> "MasterDatabase.xlsx" & "MacrosExcelFile.xls" Then
                Lastrow = wb.Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
                wb.Worksheets(1).Range("B7:J" & Lastrow).Copy
                ''
                Windows("MasterDatabase.xlsx").Activate
                Range("B" & Rows.Count).End(xlUp).Offset(1).Select
                ActiveSheet.Paste
            End If
    Next wb
End Sub

错误是“1004，应用程序定义或对象定义的错误”，它指向“Lastrow = wb.Worksheets（1）.Cells（Rows.Count，2）.End（xlUp）.Row”句子。我该怎么做才能解决这个问题？提前谢谢。

Answer 1

If wb.Name <> "MasterDatabase.xlsx" And wb.Name <> "MacrosExcelFile.xls" Then

尝试更改它。当我再测试一下时，我会更新这个答案。

Answer 2

我能够使用以下代码重现问题

Sub Tester() 
Dim lastrow As Long code here
Dim lastrow As Long
    lastrow = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
End Sub

在我的情况下，我插入了一个图表，当我运行代码时它处于活动状态。也许这有帮助。

Answer 3

我能够像那样解决“我的”问题

Sub TestB()
Dim wkb As Workbook
Dim wks As Worksheet
Dim lastrow As Long
   Set wkb = ActiveWorkbook
   Set wks = wkb.Worksheets(1)
   lastrow = wks.Cells(wks.Rows.Count, 3).End(xlUp).Row
End Sub

Answer 4

SalvadorVayshun是正确的

If wb.Name <> "MasterDatabase.xlsx" And wb.Name <> "MacrosExcelFile.xls" Then

以下是我将如何重构代码

Sub LoopCopyPaste()
    Application.ScreenUpdating = False
    Dim wb As Workbook
    Dim Lastrow As Long
    For Each wb In Application.Workbooks
        If wb.Name <> "MasterDatabase.xlsx" And wb.Name <> "MacrosExcelFile.xls" Then

            With wb.Worksheets(1)
                .Range("B7:J7", .Cells(.Rows.Count, 2).End(xlUp)).Copy
            End With

            With Workbooks("MasterDatabase.xlsx").Worksheets(1)
                .Range("B" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial
            End With

        End If
    Next wb
    Application.ScreenUpdating = True
End Sub

仅限值

Sub LoopCopyPaste()
    Application.ScreenUpdating = False
    Dim wb As Workbook
    Dim Lastrow As Long
    Dim Data
    For Each wb In Application.Workbooks
        If wb.Name <> "MasterDatabase.xlsx" And wb.Name <> "MacrosExcelFile.xls" Then

            With wb.Worksheets(1)
                Data = .Range("B7:J7", .Cells(.Rows.Count, 2).End(xlUp)).Value
            End With

            With Workbooks("MasterDatabase.xlsx").Worksheets(1)
                .Range("B" & .Rows.Count).End(xlUp).Offset(1).Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
            End With

        End If
    Next wb
    Application.ScreenUpdating = True
End Sub

值和公式

Sub LoopCopyPaste()
    Application.ScreenUpdating = False
    Dim wb As Workbook
    Dim Lastrow As Long
    Dim Data
    For Each wb In Application.Workbooks
        If wb.Name <> "MasterDatabase.xlsx" And wb.Name <> "MacrosExcelFile.xls" Then

            With wb.Worksheets(1)
                Data = .Range("B7:J7", .Cells(.Rows.Count, 2).End(xlUp)).Formula
            End With

            With Workbooks("MasterDatabase.xlsx").Worksheets(1)
                .Range("B" & .Rows.Count).End(xlUp).Offset(1).Resize(UBound(Data, 1), UBound(Data, 2)).Formula = Data
            End With

        End If
    Next wb
    Application.ScreenUpdating = True
End Sub

Excel - 尝试循环工作簿时出错

4 个答案:

仅限值

值和公式