VBA Pull data from closed multiple workbooks into Master workbook/sheet

[breg523]

Hi everyone,

Not to savvy with VBA data gymnastics however I am more familiar with excel formulation. I have a bunch of workbooks in folder 'C:\Users\BCR\Desktop\TSA' i am only interested in one sheet 'Custom Award File' and only interested in columns A-I. The first row is row title and i want to append the data into a master sheet. the title of the workbook files are dynamic, based on the date and other random naming convention. My question is, is there a macro/vba that can copy data from all the closed workbooks in sheet 'Custom Award File' into a master workbook. the sheet name does not change in any of the files. Please let me know if you have any questions. There are about 10-30 files in the folder that get updated progressively throughout the month.

 

[timo1031]

This macro assumes that the source workbooks are the only files in your folder and that they have an "xlsx" externsion. Make sure that a sheet named "Master" exists in your destination workbook and that the first row in that sheet contains your headers from A:I.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook
    Set desWS = ThisWorkbook.Sheets("Master")
    Dim LastRow As Long
    Const strPath As String = "C:\Users\BCR\Desktop\TSA\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB.Sheets("Custom Award File")
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("A2:I" & LastRow).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End With
        srcWB.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

wow....Thanks mumps. This code works for me too! But I have one question, after pulling data (column B to E of worksheet “Sheet1”) from multiple workbooks in a folder, I realize I need the date of the data in each workbook to be added in the first column of the destination worksheet. The date of the data is stored in Cell B2 of the same worksheet “Notes” of each workbook. Possible you can help by modifying the existing vba code for this additional requirement? I know how to copy date for 1 row, but I need it to be populated for all the rows for each workbook. Thanks very much in advance!

 

[mumps]

Please use code tags to post your version of the code.

 

[timo1031]

Please use code tags to post your version of the code.

Hi mumps, i am new to this forum so i am trying to post like this, not sure it will be good or not. I removed LastRow code because my data currently all has 5 rows (actually now is from B5 to E8 & B13 to E13). But going forward, my rows on source workbook is uncertain (so will just take column B to E), so I need help to know how to copy date for multiple rows depending on each file's length.

Sub ImportAccrual()

 Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook
    Set desWS = ThisWorkbook.Sheets("Data")
    Dim LastRow As Long
    Const strPath As String = "C:\Users\A\Downloads\New\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB.Sheets("Sheet1")
            
            .Range("B2").Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Range("B2").Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Range("B2").Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Range("B2").Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Range("B2").Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
            
            .Range("B5:E8").Copy
            desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 
            .Range("B13:E13").Copy
            desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

            
        End With
        srcWB.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True


End Sub

 

[timo1031]

Thank you mumps!

 

[mumps]

Is there any data in B9:E12? Could the ranges to copy change to B5:E20 and B24:E24? What data do you currently have in B13:E13?
It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[timo1031]

Is there any data in B9:E12? Could the ranges to copy change to B5:E20 and B24:E24? What data do you currently have in B13:E13?
It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

Hi Mumps, here it is. Let me know if it is still not clear.

My current data:

28-Jul-22​
	Daily	Monthly	Yearly
product A	10​	100​	150​
product B	15​	-20​	200​
product C	100​	500​	700​
product D	500​	400​	900​
adjustment	-200​	-500​	-1000​

Future data:

28-Jul-22​
	Daily	Monthly	Yearly
product A	10​	100​	150​
product B	15​	-20​	200​
product C	100​	500​	700​
product D	500​	400​	900​
product E	200​	-100​	-400​
….	….	….	….
….	….	….	….
….	….	….	….
….	….	….	….
adjustment	-200​	-500​	-1000​

 

[mumps]

I'm sorry but the data you posted has no column letters or rows numbers so that makes it difficult to modify the code. Did you try the XL2BB add-in? If not, upload your file as I suggested in Post #25.

 

[timo1031]

I'm sorry but the data you posted has no column letters or rows numbers so that makes it difficult to modify the code. Did you try the XL2BB add-in? If not, upload your file as I suggested in Post #25.

Does this looks ok? Thanks!

Current data:

temp.xlsx
	G
19
Sheet3

Future data:

temp.xlsx
	J
16
Sheet4

 

[mumps]

Unfortunately no. Use the "minisheet" option in the add-in.

 

[timo1031]

Unfortunately no. Use the "minisheet" option in the add-in.

strange, i was using minisheet.
How about now? Thanks.

Current:

temp.xlsx
	B	C	D	E
2	28-Jul-22
3
4		Daily	Monthly	Yearly
5	product A	10	100	150
6	product B	15	-20	200
7	product C	100	500	700
8	product D	500	400	900
9
10
11
12
13	adjustment	-200	-500	-1000
Sheet3

Future:

temp.xlsx
	B	C	D	E
2	28-Jul-22
3
4		Daily	Monthly	Yearly
5	product A	10	100	150
6	product B	15	-20	200
7	product C	100	500	700
8	product D	500	400	900
9	product E	200	-100	-400
10	….	….	….	….
11	….	….	….	….
12	….	….	….	….
13	….	….	….	….
14	adjustment	-200	-500	-1000
Sheet4