Copy cell J1 from multiple files and paste into column of masterfile

Question

I currently have this code which will take files from a folder, open each one, print its name into the first column of my "Master file" close it and loop through the entire folder that way.

In each file that is opened, there is information in cell J1 that I would like to copy and paste into column 3 of my "master file". The code works but will only paste the desired info from J1 into C2 over and over so the information keeps being written over. I need to increment down the list so the info from J1 is printed into the same row as the name of the file.

Any ideas?

Sub LoopThroughDirectory()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim MyFolder As String
    Dim Sht As Worksheet
    Dim i As Integer

    MyFolder = "C:\Users\trembos\Documents\TDS\progress\"

Set Sht = ActiveSheet

    'create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'get the folder object
    Set objFolder = objFSO.GetFolder(MyFolder)
    i = 1
    'loop through directory file and print names
    For Each objFile In objFolder.Files

        If LCase(Right(objFile.Name, 3)) <> "xls" And LCase(Left(Right(objFile.Name, 4), 3)) <> "xls" Then
        Else
            'print file name
            Sht.Cells(i + 1, 1) = objFile.Name
            i = i + 1
            Workbooks.Open fileName:=MyFolder & objFile.Name
        End If
        'Get TDS name of open file
        Dim NewWorkbook As Workbook
        Set NewWorkbook = Workbooks.Open(fileName:=MyFolder & objFile.Name)

        Range("J1").Select
        Selection.Copy
        Windows("masterfile.xlsm").Activate
        '
        '
        ' BELOW COMMENT NEEDS TO BE CHANGED TO INCREMENTING VALUES
        Range("D2").Select
        ActiveSheet.Paste
        NewWorkbook.Close
    Next objFile


End Sub

To find the error, add a breakpoint to the first line and use the `Step Into (F8)` to move line by line. The error will be triggered on the line that is causing it. Report that info back after you test it (edit the question). One possibility is that you are using `Sht.Cells` which will fail if the `Worksheet` is really a `Chart`. — Byron Wall, Jun 01 '15 at 15:59
@Byron Thank you! I have reported back after playing with the text. Any advice on the new problem? — Taylor, Jun 01 '15 at 16:13
At this point, your question has entered the realm of 100s of questions on this site `How do I copy from [somewhere] and paste to [somewhere]`. I would look around at some of those questions for general advice. Specifically for this code, why don't you do the copy/paste stuff inside the `Else` before you increment `i`? Then you can just use `Cells(i+1,2)` to paste next to the filename. It's also not clear why you open the file twice. — Byron Wall, Jun 01 '15 at 16:22
I am not trying to open the file twice. To fix that I would enter the new code for copy/paste under the else section before the End If and increment it from Sht.Cells(i+1, 2) ? — Taylor, Jun 01 '15 at 16:36

score 0 · Answer 1 · answered Jun 03 '15 at 03:44

I do some modification on your code and it shows the result that needed by you.
Please take note that your macro may spoil if your folder got other extension of files.
You may increase the performance of this macro by using the following code :
Application.ScreenUpdating = False

Option Explicit

Dim MyMasterWorkbook As Workbook
Dim MyDataWorkbook As Workbook
Dim MyMasterWorksheet As Worksheet
Dim MyDataWorksheet As Worksheet

Sub LoopThroughDirectory()

Set MyMasterWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyMasterWorksheet = MyMasterWorkbook.ActiveSheet

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim MyDataFolder As String
Dim MyFilePointer As Byte

MyDataFolder = "C:\Users\lengkgan\Desktop\Testing\"
MyFilePointer = 1

'create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'get the data folder object
Set objFolder = objFSO.GetFolder(MyDataFolder)

'loop through directory file and print names
For Each objFile In objFolder.Files

    If LCase(Right(objFile.Name, 3)) <> "xls" And LCase(Left(Right(objFile.Name, 4), 3)) <> "xls" Then
    Else
        'print file name
        MyMasterWorksheet.Cells(MyFilePointer + 1, 1) = objFile.Name
        MyFilePointer = MyFilePointer + 1
        Workbooks.Open Filename:=MyDataFolder & objFile.Name
    End If

'Get TDS name of open file
Set MyDataWorkbook = Workbooks.Open(Filename:=MyDataFolder & objFile.Name)
Set MyDataWorksheet = MyDataWorkbook.ActiveSheet

'Get the value of J1
MyMasterWorksheet.Range("C" & MyFilePointer).Value = MyDataWorksheet.Range("J1").Value

'close the workbook without saving it
MyDataWorkbook.Close (False)
Next objFile
End Sub

keong, I highly recommend you start using Long as opposed to Byte, Byte is restricted to 255, what happens if there are more than 255 files in the folder? The code will crash with an overflow error. Integer would normally be better but in VBA it is redundant and well documented that Long is the way to go. — Dan Donoghue, Jun 03 '15 at 04:23
No probs, hope it helps :). I do advise reading up on VBA and Integer though, it's quite interesting reading how it deals with it and why we should use long instead (even though old school coders were taught otherwise) — Dan Donoghue, Jun 03 '15 at 05:29
Hi Dan,something did come to my mind regarding dimming the variable type as long. I was wondering that did integer already more than enough compare to long? Don't you think that declaring the variable as long will over-allocate the resource? — keong kenshih, Jun 03 '15 at 05:37
As a programmer yes we are taught to use as little ram as possible and only what is needed but not in VBA. This will give you the full explanation. Don't worry, it's a trap that everyone falls into, it took me ages to learn about :) http://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long — Dan Donoghue, Jun 03 '15 at 05:40
Thank you, that clear my doubts. Your are so professional. Once again, thanks a lot. — keong kenshih, Jun 03 '15 at 05:45

score 0 · Answer 2 · answered Jun 03 '15 at 04:17

IF the sheetname is consistent across the files ie "Sheet1", you can do this without opening the files:

Sub LoopThroughDirectory()
    Dim objFSO As Object, objFolder As Object, objFile As Object, MyFolder As String, Sht As Worksheet
    MyFolder = "C:\Users\trembos\Documents\TDS\progress\"
    Set Sht = ActiveSheet
    'create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'get the folder object
    Set objFolder = objFSO.GetFolder(MyFolder)
    'loop through directory file and print names
    For Each objFile In objFolder.Files
        If Not LCase(Right(objFile.Name, 3)) <> "xls" And Not LCase(Left(Right(objFile.Name, 4), 3)) <> "xls" Then
            'print file name
            Sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Formula = objFile.Name
            Sht.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Formula = ExecuteExcel4Macro("'" & MyFolder & objFile.Name & "Sheet1'!R1C10") 'This reads from a closed file
        End If
    Next objFile
End Sub

score 0 · Accepted Answer · answered Jun 03 '15 at 12:25

This is the solution that works:

'print J1 values to Column 4 of masterfile
        With WB
            For Each ws In .Worksheets
                StartSht.Cells(i + 1, 1) = objFile.Name
                With ws
                    .Range("J1").Copy StartSht.Cells(i + 1, 4)
                End With
                i = i + 1
            'move to next file
            Next ws
            'close, do not save any changes to the opened files
            .Close SaveChanges:=False


        End With

Copy cell J1 from multiple files and paste into column of masterfile

3 Answers3

Linked