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

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

Answer 1

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

Answer 2

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

Answer 3

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