VBA for 5 files to Master

[RR786]

I have about 5 files with data in columns A through BU. All 5 files have different names but 'data' is in worksheet.

i need a VBA to consolidate the data thats re all different length but only keeping current title in the Master file called 'Master'


Trying to get a VBA code to:

1. Clear data from master file
2. Open each of the 5 files. (TASS, MUC, SAS etc) but common start is 'Underlying Bridge - '
3. copy columns row 2 to where ever the data goes to and then add additional from file 2,3,4 etc
3. paste data tab within master file.

Can this be done? Thanks in advance.

 

[JLGWhiz]

If the workbooks are in a single folder and the Master workbook is in the same folder and those are the onlyh Excel files in that folder then.

Sub t()
Dim sh As Worksheet, wb As Workbook, fPath As String, fName As String
fPath = ThisWorkbook.Path & "\"
Set sh = ThisWorkbook.Sheets("Data")
sh.UsedRange.Offset(1).ClearContents
fName = Dir(fPath & "*.xls*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            wb.Sheets(1).UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            wb.Close False
        End If
        fName = Dir
    Loop
End Sub

 

[RR786]

hi, thanks

but its not working - it clears the data in the master file but does not copy and past values from other 5 files within the folder into the master file

i removed the sub t() - as i am using a command button to click on to update
-----


Private Sub CommandButton1_Click()

Dim sh As Worksheet, wb As Workbook, fPath As String, fName As String

fPath = ThisWorkbook.Path & "\\20-21\Business Planning\Budgets\"

Set sh = ThisWorkbook.Sheets("Data")

sh.UsedRange.Offset(1).ClearContents

fName = Dir(fPath & "*.xls*")
Do While fName <> ""
If fName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(fPath & fName)
wb.Sheets("Data").UsedRange.Offset("Data").Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
wb.Close False
End If
fName = Dir
Loop
End Sub

 

[JLGWhiz]

fPath = ThisWorkbook.Path & "\\20-21\Business Planning\Budgets\"

This mod you made does not look like a valid subdirectory with the double back slashes (\\). It would probably work better if you use the full directory name and not concatenate it to the Master workbook directory. Just eliminate what I had in there after the equal sign and put the full directory path.

wb.Sheets("Data").UsedRange.Offset("Data").Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)

This line won't work with the offset statement you changed. Try this one

wb.Sheets("Data").UsedRange.Offset1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)

 

[RR786]

Nope even i add the actual path on an M drive

none of the files open and paste values into the master file i am in

am i supposed to fill anything else in the code? or do i need to open and close the files manually?

[Private Sub CommandButton1_Click()
Dim sh As Worksheet, wb As Workbook, fPath As String, fName As String
fPath = ThisWorkbook.Path & "M:\Site\20-21\Business Planning\Budgets\"
Set sh = ThisWorkbook.Sheets("Data")
sh.UsedRange.Offset(1).ClearContents
fName = Dir(fPath & "*.xlsx")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            wb.Sheets("Data").UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            wb.Close False
        End If
        fName = Dir
    Loop
End Sub]

 

[JLGWhiz]

Try this

Private Sub CommandButton1_Click()
Dim sh As Worksheet, wb As Workbook, fPath As String, fName As String
fPath = "M:\Site\20-21\Business Planning\Budgets\"
Set sh = ThisWorkbook.Sheets("Data")
sh.UsedRange.Offset(1).ClearContents
fName = Dir(fPath & "*.xlsx")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            wb.Sheets("Data").UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            wb.Close False
        End If
        fName = Dir
    Loop
End Sub

 

[RR786]

hey, its working - one small thing i need it to paste values and when the files open i dont want to update links

 

[JLGWhiz]

hey, its working - one small thing i need it to paste values and when the files open i dont want to update links

delete this line:

wb.Sheets("Data").UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)

Replace it with these two lines"

wb.Sheets("Data").UsedRange.Offset(1).Copy
sh.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValue

 

[RR786]

- broken again

getting a run-time error 1004
application -defined or object error

[Private Sub CommandButton1_Click()
Dim sh As Worksheet, wb As Workbook, fPath As String, fName As String
fPath = "M:\Site\20-21\Business Planning\Budgets\"
Set sh = ThisWorkbook.Sheets("Data")
sh.UsedRange.Offset(1).ClearContents
fName = Dir(fPath & "*.xls*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            wb.Sheets("Data").UsedRange.Offset(1).Copy
            sh.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValue
            wb.Close False
        End If
        fName = Dir
    Loop
End Sub

/CODE]

 

[JLGWhiz]

should be

xlPasteValues

plural. Sorry bout that.