Excel VBA运行时间1004 Ms Excel不能粘贴数据

我正在使用此macros来自动复制和粘贴一个Excel文件的单元格范围到另一个。 这似乎是正常工作8-10文件。 但是我必须处理大约49个文件，那就是当我遇到问题时。 我得到一个运行时错误1004：Ms Excel不能粘贴数据。

以下是debugging器带给我的代码行：

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 End Sub

我不知道如何有时它在FILE NO18上有时崩溃，有时在FILE NO 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