CODEWITHSUNDEEP
excelvbaruntime
Silvia Stoyanova
Silvia Stoyanova

Reputation: 281

Excel VBA Run-time 1004 Ms Excel cannot paste the data

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

Upvotes: 1

Views: 4664

Answers (1)

Bernard Saucier
Bernard Saucier

Reputation: 2260

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

Upvotes: 2

Related Questions