I can't get my consolidation macro working

[jamesplant77]

Hi, I am really new to VBA and I have created a number of workbooks that Project Managers are required to complete and submit to a folder each month:

M:\Business Change - Projects\PMO\JAMES - TEST\Demand Management\Resource Forecasts

The only tab they are required to complete is the one titled FORECAST. Once all workbooks have submitted, I want to be able to run a macro that takes all data from row 6 onwards, in each workbook and paste to the open workbook from row A6 which is exactly the same layout as the individual workbooks.

I would also need the code to stop at the last row that contained data, then move onto the next workbook and then paste that data on the next empty row in the master. I have masses of MI that will be taken from the master sheet, so really need this to work.

I have pasted the headers that appear in the master and the workbooks below, headers are in cells A4, B4 etc and the data I need is in the range A6:BO6

ROLE

COST P/D

PROJECT NAME

PROJECT ID (COST CENTRE)

STATUS

NAME OF RESOURCE

FTE

J

F

M

A

M

J

J

A

S

O

N

D

21

20

22

20

19

22

23

20

22

22

21

21

<colgroup><col style="width: 158pt; mso-width-source: userset; mso-width-alt: 7716;" width="211"> <col style="width: 80pt; mso-width-source: userset; mso-width-alt: 3913;" width="107"> <col style="width: 209pt; mso-width-source: userset; mso-width-alt: 10203;" width="279"> <col style="width: 83pt; mso-width-source: userset; mso-width-alt: 4059;" span="2" width="111"> <col style="width: 188pt; mso-width-source: userset; mso-width-alt: 9179;" width="251"> <col style="width: 38pt; mso-width-source: userset; mso-width-alt: 1828;" width="50"> <col style="width: 32pt; mso-width-source: userset; mso-width-alt: 1536;" span="12" width="42"> <tbody>
</tbody>

 

[JLGWhiz]

This assumes that the code will be hosted by the master workbook.

Sub consolidate()
Dim wb As Workbook, sh As Worksheet, fPath As String, fName As String
fPath = "M:\Business Change - Projects\PMO\JAMES - TEST\Demand Management\Resource Forecasts\"
fName = Dir(fPath & "*.xl*")
    Do While fName <> ""
        Set wb = Workbooks.Open(fPath & fName)
        Set sh = wb.Sheets("FORECAST")
            If Application.CountA(ThisWorkbook.Sheets(1).Rows(6)) = 0 Then
                sh.UsedRange.Offset(5).Copy ThisWorkbook.Sheets(1).Range("A6")
            Else
                sh.UsedRange.Offset(5).Copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        wb.Close False
        fName = Dir
    Loop
End Sub

Copy this code to the standard code module 1 of the master workbook. The workbook should be saved as a macro enabled workbook (.xlsm) to preserve the code. Be sure you have set your security center settings to allow access to VBA and macros.