VBA code to copy values from same cell over multiple workbooks into one

[bmbaadte]

Hello All,

New to this forum and looking for some help. I have the need to copy the values from the same cell in multiple workbooks in the same folder into a master file. I have come up with some basic VBA code that will sum the values of the same cell over multiple files and place that total into a cell in my reports worksheet. I now need to take the values for Cell R153 from every file in a folder and sequentialy paste it into the master report.xlsm file to sheet 2 starting H2. I was hoping to modify the below code to achieve what i need.



Sub PROCESS_FILES()
Dim MyFolder As String
Dim MyFile As String
Dim MyValue As Single
'--------------------
MyValue = 0
MyFolder = "Z:\Billable Hours\Weekly Totals 2019"
MyFile = Dir(MyFolder & "*.XLSX")
Do While MyFile <> ""
Application.StatusBar = MyFile
Workbooks.Open Filename:=MyFolder & MyFile
MyValue = ActiveWorkbook.Sheets(1).Range("R149").Value
ActiveWorkbook.Close savechanges:=False
MyFile = Dir
Loop
ThisWorkbook.Sheets(2).Range("H2").Value = MyValue
MsgBox (MyValue)
Application.StatusBar = False
End Sub

 

[JLGWhiz]

Sub PROCESS_FILES()
Dim MyFolder As String
Dim MyFile As String
Dim MyValue As Single '--------------------
Dim wb As Workbook
MyFolder = "Z:\Billable Hours\Weekly Totals 2019\"
MyFile = Dir(MyFolder & "*.XLSX")
    Do While MyFile <> ""
        Set wb = Workbooks.Open(MyFolder & MyFile)
        MyValue = ActiveWorkbook.Sheets(1).Range("R153").Value
        ThisWorkbook.Sheets(2).Cells(Rows.Count, "H").End(xlUp)(2) = MyValue
        wb.Close savechanges:=False
        MyFile = Dir
    Loop
Application.StatusBar = False
End Sub

 

[bmbaadte]

Thanks very much. Have the code working quite well. However have another question, for some reason when the code runs, it is not opening and reading the files in the order that they exist in the folder. Is there an easy way to get the loop through command to read the files in the order that they exist in the folder? They are alphabetically labeled "Weekly Totals 1.xlsx", "Weekly Totals 2.xlsx", etc.

 

[JLGWhiz]

The directory default is to list the files alphanumeric and the Dir function would normally produce them in that same order. But it might go from 1 to 10 thtu 19 and then 2, etc. for digital numeric sorting. One way around that is to use leading zeros in your numbering system. Another way to use a list to call the files up instead of using the Dir funtion, or to use the Applicataion.GetFileName dialog box with multiple select to create your call list. Without seeing the directory, I can't offer too much more.

 

[bmbaadte]

Below is a copy of my directory structure. Interestingly, my code is reading the file named "Weekly Totals G.xlsx" first then reads the file name "Weekly Totals J.xlsx" second.

Weekly Totals A.xlsx
Weekly Totals B.xlsx
Weekly Totals C.xlsx
Weekly Totals D.xlsx
Weekly Totals E.xlsx
Weekly Totals F.xlsx
Weekly Totals G.xlsx

The file names increment by the last letter. Currently my last file is "Weekly Totals N.xlsx"


So for what ever reason the Workbooks.Open is not looping through the files in order. The report I am trying to generate requires the data be read in order.
Below is a screen shot of my code that is currently running:

Sub PROCESS_FILES()
Dim MyFolder As String
Dim MyFile As String
Dim MyValue As Single
Dim MyValue2 As Single
Dim MyValue3 As Single
Dim MyValue4 As Single
Dim MyValue5 As String '--------------------

Dim wb As Workbook
MyFolder = "Z:\Billable Hours\Weekly Totals 2019"
MyFile = Dir(MyFolder & "Weekly Totals*.XLSX")
Do While MyFile <> ""
Set wb = Workbooks.Open(MyFolder & MyFile, True)
MyValue = ActiveWorkbook.Sheets(1).Range("R149").Value
ThisWorkbook.Sheets(2).Cells(Rows.Count, "B").End(xlUp)(2) = MyValue

MyValue2 = ActiveWorkbook.Sheets(1).Range("R150").Value
ThisWorkbook.Sheets(2).Cells(Rows.Count, "C").End(xlUp)(2) = MyValue2

MyValue3 = ActiveWorkbook.Sheets(1).Range("R151").Value
ThisWorkbook.Sheets(2).Cells(Rows.Count, "D").End(xlUp)(2) = MyValue3

MyValue4 = ActiveWorkbook.Sheets(1).Range("R152").Value
ThisWorkbook.Sheets(2).Cells(Rows.Count, "E").End(xlUp)(2) = MyValue4

MyValue5 = ActiveWorkbook.Sheets(1).Range("A1").Value
ThisWorkbook.Sheets(2).Cells(Rows.Count, "A").End(xlUp)(2) = MyValue5

wb.Close savechanges:=False
MyFile = Dir
Loop
Application.StatusBar = False
End Sub






PS: how do you post your code in the sub-window>? Sorry if this was a dumb question. Very new to this forum and VBA.

 

[bmbaadte]

Ok, so figured out how to post the code. Here is what is running:

Sub PROCESS_FILES()
Dim MyFolder As String
Dim MyFile As String
Dim MyValue As Single
Dim MyValue2 As Single
Dim MyValue3 As Single
Dim MyValue4 As Single
Dim MyValue5 As String '--------------------

Dim wb As Workbook
MyFolder = "Z:\Billable Hours\Weekly Totals 2019\"
MyFile = Dir(MyFolder & "Weekly Totals*.XLSX")
    Do While MyFile <> ""
        Set wb = Workbooks.Open(MyFolder & MyFile, True)
        MyValue = ActiveWorkbook.Sheets(1).Range("R149").Value
        ThisWorkbook.Sheets(2).Cells(Rows.Count, "B").End(xlUp)(2) = MyValue
        
        MyValue2 = ActiveWorkbook.Sheets(1).Range("R150").Value
        ThisWorkbook.Sheets(2).Cells(Rows.Count, "C").End(xlUp)(2) = MyValue2
        
        MyValue3 = ActiveWorkbook.Sheets(1).Range("R151").Value
        ThisWorkbook.Sheets(2).Cells(Rows.Count, "D").End(xlUp)(2) = MyValue3
        
        MyValue4 = ActiveWorkbook.Sheets(1).Range("R152").Value
        ThisWorkbook.Sheets(2).Cells(Rows.Count, "E").End(xlUp)(2) = MyValue4
        
        MyValue5 = ActiveWorkbook.Sheets(1).Range("A1").Value
        ThisWorkbook.Sheets(2).Cells(Rows.Count, "A").End(xlUp)(2) = MyValue5
                
        wb.Close savechanges:=False
        MyFile = Dir
    Loop
Application.StatusBar = False
End Sub

 

[JLGWhiz]

It is not the code that is causing the files to be called out of order by the alpha suffix. It could be spaces or the file might have been inadvertantly saved as a macro enabled workbook giving it a .xlsm extension which would put it before all the .xlsx extensions. The sequence problem is somewhere in the file name, not the code. If you cannot get it to put them in order any other way, you might have to list the files on a sheet and call them from the list.

 

[JLGWhiz]

Here is an example of how to list your files and then call them up with code. I used Sheet2 in the host workbook arbitrarily. You can put the list wherever you like, just change the code with red font to reflect the change.


Sheet2: Column A
Weekly Totals A.xlsx
Weekly Totals B.xlsx
Weekly Totals C.xlsx
Weekly Totals D.xlsx
Weekly Totals E.xlsx
Weekly Totals F.xlsx
Weekly Totals G.xlsx

Dim c As Range, wb As Workbook, MyFolder As String, sh As Worksheet
MyFolder = "Z:\Billable Hours\Weekly Totals 2019\"
For Each c In [COLOR=#ff0000]Sheet2.Range("A1", Sheet2.Cells(Rows.Count, 1).End(xlUp))[/COLOR] 'Sheet2 is arbitrary, change as needed
    Set wb = Workbooks.Open(MyFolder & c.Value)
    Set sh = wb.Sheets(1)  
    ThisWorkbook.Sheets(2).Cells(Rows.Count, "B").End(xlUp)(2) = sh.Range("R149"),Value
    ThisWorkbook.Sheets(2).Cells(Rows.Count, "C").End(xlUp)(2) = sh.Range("R150").Value
    ThisWorkbook.Sheets(2).Cells(Rows.Count, "D").End(xlUp)(2) = sh.Range("R151").Value
    ThisWorkbook.Sheets(2).Cells(Rows.Count, "E").End(xlUp)(2) = sh.Range("R152").Value
    ThisWorkbook.Sheets(2).Cells(Rows.Count, "A").End(xlUp)(2) = sh.Range("A1").Value
    wb.Close savechanges:=False
Next

 

[bmbaadte]

Thanks for that. I really appreciate the help. Think I got it solved. The folder resides on a network drive. I moved the folder to my machine, pointed the code to the folder on my machine and it reads everything in order. Not sure why. Ultimately, I will use the list function and put it back on the network drive.

 

[JLGWhiz]

It is possible that the networkdrive is set to sort the files by 'Last Modified' date, which could make them out of name sequence. A user can change the way the files are sorted, but Windows default is AlphaNumeric by filename. When working on a share drive, it is sometimes difficult to control what different users manage to do to the files. That is why many companys limit the permissions of users.
Thanks for the feedback and good luck.
Regards, JLG