【问题标题】:Excel - Error when trying to loop through workbooksExcel - 尝试循环浏览工作簿时出错
【发布时间】:2017-04-10 05:23:23
【问题描述】:

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

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”句子。 我能做些什么来解决这个问题? 提前致谢。

【问题讨论】:

  • 我没有仔细查看它是否与您的问题有关,但If wb.Name &lt;&gt; "MasterDatabase.xlsx" &amp; "MacrosExcelFile.xls" Then 相当于If wb.Name &lt;&gt; "MasterDatabase.xlsxMacrosExcelFile.xls" Then。你想要If wb.Name &lt;&gt; "MasterDatabase.xlsx" And wb.Name &lt;&gt; "MacrosExcelFile.xls" Then
  • 我猜您的问题实际上与不合格的Rows.CountRange 有关。尝试更改它们以包含您所指的电子表格。 (第一个是Lastrow = wb.Worksheets(1).Cells(wb.Worksheets(1).Rows.Count, 2).End(xlUp).Row,这可能是导致问题的原因,但后一个也应该更改以确保安全。)哎呀 - 没有充分阅读你的问题 -那个不合格的Rows.Count 绝对是你的问题。
  • 这绝对是问题所在!代码我看了一千遍还是搞不懂,多谢朋友!

标签: vba excel


【解决方案1】:

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

【讨论】:

    【解决方案2】:

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

    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
    

    【讨论】:

      【解决方案3】:

      我能够通过以下代码重现问题

      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
      

      在我的例子中,我插入了一个图表,当我运行代码时它处于活动状态。也许这会有所帮助。

      【讨论】:

        【解决方案4】:
        If wb.Name <> "MasterDatabase.xlsx" And wb.Name <> "MacrosExcelFile.xls" Then
        

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

        【讨论】:

        • 这是另一个我没有发现的问题 ;) 非常感谢!
        猜你喜欢
        • 1970-01-01
        • 2014-12-23
        • 2014-09-15
        • 1970-01-01
        • 1970-01-01
        • 2020-07-08
        • 2015-08-06
        • 2018-05-27
        • 1970-01-01
        相关资源
        最近更新 更多