2
votes

I want to copy the data of several worksheets into one worksheet and copy everything from the table except the first row.

PasteSpecial fails sometimes with

Error 1004 "pastespecial method of range class failed"

I can click "debug" and then start again and the code continues copying. When I do this several time through the process I get to the end.

I tried other paste modes like .paste and added .activate and .select statements.

Any idea why this behavior occurs and how it could be fixed?

Option Explicit

Sub RunOnAllFilesInFolder()

    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim sht As Worksheet
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Dim LastRowWb As Integer, LastRow As Integer
    Dim eof As Integer
    
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet
    
    Set ws = ThisWorkbook.Worksheets("Artikelliste")
    
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.Path
    If fDialog.Show = -1 Then
        folderName = fDialog.SelectedItems(1)
    End If
    
    Set eApp = New Excel.Application:  eApp.Visible = False
    
    fileName = Dir(folderName & "\*.*")
    
    LastRow = 2
    
    Do While fileName <> ""
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & folderName & "\" & fileName
 
        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
        Set sht = wb.Worksheets("Tabelle1")
        
        LastRowWb = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
        
        sht.Activate
        sht.Range("A2" & ":" & "AM" & LastRowWb).Copy
        
        ws.Range("A" & LastRow).PasteSpecial Paste:=xlPasteFormats
        ws.Cells(LastRow, 15).Value = fileName

        ThisWorkbook.Save
        LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1

        eApp.CutCopyMode = False
        
        wb.Close SaveChanges:=False 
        Debug.Print "Processed " & folderName & "\" & fileName
        fileName = Dir()
    Loop
    
    eApp.Quit
    Set eApp = Nothing
    Application.DisplayAlerts = True
    
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
    
End Sub
1

1 Answers

2
votes

Any idea why this strange behavior occurs and how it even could be fixed?

  1. Excel has an uncanny habit of clearing the clipboard and hence it is advisable not to do anything else between copy and paste operations

  2. You need to give Excel time to place data on the clipboard. Especially when you are trying to perform Copy-Paste operation in a loop.

Try this

sht.Range("A2:AM" & LastRowWb).Copy
DoEvents
ws.Range("A" & LastRow).PasteSpecial Paste:=xlPasteFormats

On a side note, you may also want to read up on How to avoid using Select in Excel VBA