VBA Copy data from multiple workbooks in a folder, from a specific cell range on a single sheet into a single consolidation sheet in another workbook

[chappy]

I have a single consolidation workbook called "Consolidation"
I have multiple source workbooks stored in the same folder (Path "W:\Sourcedata\Opps")
In each of these source workbooks there is data on a worksheet called "Key_metrics". The sheet name will not change
The data is stored in cell range B5:BE64. The source data cell range will not change

I would like to copy the data from the source data cell range in B5:BE64 on worksheet "Key_metrics" from each of the workbooks in the folder into a sheet named "Consol" in the "Consolidation" workbook. I would like to copy and paste values into the next blank row available in column B.

If anyone can assist me it would be very much appreciated.

Thanks in advance

 

[JLGWhiz]

Give this a try

Sub t()
Dim fPath As String, fName As String, wb As Workbook, sh As Worksheet
fPath = "W:\Sourcedata\Opps\"
sh = Workbooks("Consolidation.xlsm").Sheets("Consol")
fName = Dir(fPath & "*.xls*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
                On Error Resume Next
                    If Not Sheets("Key_metrics") Is Nothing Then
                        Sheets("Key_metrics").Range("B5:BE64").Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                    End If
                On Error GoTo 0
                Err.Clear
                wb.Close False
        End If
        fName = Dir
    Loop
End Sub

 

[chappy]

Give this a try

Sub t()
Dim fPath As String, fName As String, wb As Workbook, sh As Worksheet
fPath = "W:\Sourcedata\Opps\"
sh = Workbooks("Consolidation.xlsm").Sheets("Consol")
fName = Dir(fPath & "*.xls*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
                On Error Resume Next
                    If Not Sheets("Key_metrics") Is Nothing Then
                        Sheets("Key_metrics").Range("B5:BE64").Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                    End If
                On Error GoTo 0
                Err.Clear
                wb.Close False
        End If
        fName = Dir
    Loop
End Sub

Thanks JLGWhiz. When I step into the code and run through line by line a

"Run-time error '91': Object variable or With block variable no set" error is triggered

The message appears at the "sh = Workbooks("Consolidation.xlsm").Sheets("Consol")" line.

Any ideas? Thanks again for responding

 

[JLGWhiz]

I forgot to use Set in fron of the sh, so the object variable is not setting. Should be

Set sh = Workbooks("Consolidation.xlsm").Sheets("Consol")

 

[chappy]

I forgot to use Set in fron of the sh, so the object variable is not setting. Should be

Set sh = Workbooks("Consolidation.xlsm").Sheets("Consol")

With a small tweak to paste formats as well as values it is working perfectly now thank you.

Sub Consol()
Dim fPath As String
Dim fName As String
Dim wb As Workbook
Dim sh As Worksheet

fPath = "W:\Sourcedata\Opps\" sh = Workbooks("Consolidation.xlsm").Sheets("Consol")
fName = Dir(fPath & "*.xls*")
Do While fName <> ""
If fName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(fPath & fName)
On Error Resume Next
If Not Sheets("Key_metrics") Is Nothing Then
Sheets("Key_metrics").Range("B5:BE64").Copy
sh.Cells(Rows.Count, 2).End(xlUp).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
On Error GoTo 0
Err.Clear
wb.Close False
End If
fName = Dir
    Loop

End Sub

 

[JLGWhiz]

You're welcome,
regards, JLG