Copy/Paste using column headers in VBA
I have a folder that opens worksheets one by one, takes information from them, and puts that information into a master file.
I am trying to copy information from one worksheet under the header "CUTTING TOOL", typically that header starts at G10, (copy the information underneath it until you reach the bottom cell) and then paste it into column C of a different worksheet continuing to loop through each worksheet to do the same..
I also am trying to copy information from one worksheet in cell J1 and pasting it into column 4 and continuing to loop through each worksheet to do the same.
Help with either of these problems would be very helpful! Here is my current code.
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
'Speed up process by not updating the screen
'Application.ScreenUpdating = False
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
'Range("D2").Select
'ActiveSheet.Paste
ActiveWorkbook.Close
Next objFile
'Application.ScreenUpdating = True
End Sub
Recent comments
5 years 36 weeks ago
6 years 22 weeks ago
6 years 34 weeks ago
6 years 37 weeks ago
6 years 38 weeks ago
6 years 43 weeks ago
6 years 52 weeks ago
7 years 2 days ago
7 years 3 days ago
7 years 3 days ago