1
votes

I am using this Macro to automatically copy and paste a range of cells from one Excel file to another. It seems to be working fine with 8-10 files. But I have to process about 49 files and that is when i face an issue. I get a RUN TIME ERROR 1004: Ms Excel cannot paste data.

Here is the line of code that the debugger takes me to:

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

And here is all of the code i am using:

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

I dont understand how sometimes it crashesh on FILE NO18, sometimes on FILE NO 29?Plus the code seems to be working fine when i run it with F8. Could you please help me to solve that issue?

Thanks

1
Just a guess, but it might be clearing the clipboard when you close a workbook that's relatively large. Instead of pasting after ActiveWorkbook.Close try pasting first -- you'll have to create a variable a the top to hold ActiveSheet (ex. dim origWS as WorkSheet : set origWS = activeworksheet), then origWS.Paste.... - Joe
What is the value of emptyRow what this error occurs? - ttaaoossuuuu

1 Answers

2
votes

There were a few things that seemed wrong with your code. I went ahead and cleaned it up for you. It should correct the errors as well.

Try this!

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