Question

我正在使用此宏自动将一系列单元格从一个Excel文件复制并粘贴到另一个Excel文件中。它似乎与8-10个文件一起正常工作。但我必须处理大约49个文件，这是我遇到问题的时候。我得到一个RUN TIME ERROR 1004：Excel女士无法粘贴数据。

以下是调试器带我到的代码行：

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(emptyRow, 1), Cells(emptyRow, 23))

以下是我正在使用的所有代码：

Sub AllFilesProject1()
Dim folderPath As String
Dim filename As String
Dim wb As Workbook

folderPath = "C:\Users\enchevay\Desktop\automation\WeeklyReports\"

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xlsx")
Do While filename <> ""
  Application.ScreenUpdating = False


   'copy & paste range of information
   Set wb = Workbooks.Open(folderPath & filename)
   wb.Worksheets("Report Figures (hidden)").Visible = True
   Worksheets("Report Figures (hidden)").Range("A3:W3").Copy
   emptyRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
   Application.DisplayAlerts = False
   ActiveWorkbook.Close
   ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(emptyRow, 1), Cells(emptyRow, 23))

    Application.ScreenUpdating = True
    filename = Dir
Loop

'Application.ScreenUpdating = True 结束子

我不明白它有时会在FILE NO18上崩溃，有时会在29号文件上崩溃吗？加上代码似乎在用F8运行时工作正常。你能帮我解决一下这个问题吗？

由于

Answer 1

您的代码似乎有些问题。我继续为你清理它。它也应该纠正错误。

试试这个！

Sub AllFilesProject1()
    Dim folderPath As String
    Dim filename As String
    Dim wb1 As Workbook, wb2 As Workbook
    Set wb1 = ThisWorkbook

    folderPath = "C:\Users\enchevay\Desktop\automation\WeeklyReports\"

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

    filename = Dir(folderPath & "*.xlsx")
    Do While filename <> ""
        Application.ScreenUpdating = False

        'copy & paste range of information
        Set wb2 = Workbooks.Open(folderPath & filename)
        wb2.Worksheets("Report Figures (hidden)").Visible = True
        emptyrow = wb1.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        wb2.Worksheets("Report Figures (hidden)").Range("A3:W3").Copy _
            Destination:=wb1.Worksheets("Sheet1").Range(Cells(emptyrow, 1), Cells(emptyrow, 23))

        Application.DisplayAlerts = False
        wb2.Close
        Application.DisplayAlerts = True

        Application.ScreenUpdating = True
        filename = Dir
    Loop

End Sub

Excel VBA运行时1004 Excel无法粘贴数据

1 个答案: