Copying rows from multiple documents into single sheet

[Kovu159]

Hello,

For a project at work, I have a folder full of identicle documents. On the page "Manager Summary" is a 5 row table I need to copy into a consoidated list. That consolidated list needs each table from each document in a long table. Essentally it is copying every table and pasting them one underneith another in a consolidated spreadsheet.

In my consolidation form, I have the following code:

Sub ReadFolder()
'
' ReadFolder Macro
'
Dim fPath As String, fName As String
Dim RowNum As Integer
RowNum = 9
Dim src As Workbook
Set src = ActiveWorkbook
Dim dst As Workbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
fPath = "C:\Users\*******\Desktop\IT Capability Assessment\Output Files\"
fName = Dir(fPath & "*.xlsx")

    Do While Len(fName) > 0
        Workbooks.Open fPath & fName
        Set dst = ActiveWorkbook
        fName = Left(fName, InStr(fName, ".") - 1)
              
        Sheets("Managers Summary").Select ' possible error in title format
        Rows("7:11").Select
        ActiveSheet.Copy
        src.Activate
        Rows(RowNum).EntireRow.Select
        ActiveSheet.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        RowNum = RowNum + 5
        
        dst.Activate
        ActiveWorkbook.Close False
        fName = Dir
        src.Activate
    Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True


'
End Sub

This is doing a couple wierd things. It opens the first file, selects the rows, then some wierd things happen. First,
Error.png
Attachment 147820

I get this error: Method "PasteSpecial" of object '_Worksheet' failed

Also, it opens up a new workbook with a copy of the sheet "Manager Summary".

Google has failed me, and I have banged on this code for awhile, any help would be greatly appreciated!

[PingPing]

You've got a lot of Activate/Select/Copy/Paste stuff in your code that is not necessary and is difficult to follow.
I'd suggest trying the following code and see if that gives you errors.
Note: I've assumed the worksheet you're 'pasting' the data to is called "Sheet1". If not, you'll need to change the line of code accordingly.

Public Sub ReadFolder()

          Dim wkbSrc As Workbook
          Dim wkbDest As Workbook: Set wkbDest = ActiveWorkbook
          Dim rngSrc As Range, rngDest As Range
          Dim strFilePath As String, strFileName As String
          Dim lngRow As Long: lngRow = 9
          
          Application.DisplayAlerts = False
          Application.ScreenUpdating = False
          
          strFilePath = "C:\Users\*******\Desktop\IT Capability Assessment\Output Files\"
          strFileName = Dir(strFilePath & "*.xlsx")
          
          Do While Len(strFileName) > 0
                    
                    Set wkbSrc = Workbooks.Open(strFilePath & strFileName)
                    Set rngSrc = wkbSrc.Sheets("Managers Summary").Rows("7:11")
                    
                    Set rngDest = wkbDest.Sheets("Sheet1").Rows(lngRow & ":" & lngRow + 4) 'is "Sheet1" the name of the destination sheet?
                    
                    rngDest.Value = rngSrc.Value
                    
                    lngRow = lngRow + 5
                    
                    wkbSrc.Close False
                    
                    strFileName = Dir
          Loop
          
          Application.DisplayAlerts = True
          Application.ScreenUpdating = True

End Sub

[Kovu159]

You are my hero PingPing! Thanks!

I'm marking this as solved, but have one other quick question. The rows I am copying have merged cells and conditional formatting that highlights certain cells based on their values. Is there a way to use a PasteSpecial to carry over these merged cells and formatting?

Thanks!