How can I copy the columns (data only) with these column header names "TOOL CUTTER" and "HOLDER" and paste them (as an append in just one column each with the same column header name) into another workbook sheet where the VBA code ( Sheet Module) is. Thanks.
The line "If Sht <> "masterfile.xls" Then
is where the problem occurs. I got help from another online source where this line was If ws.name <> me.name Then
clearly I was meant to put a different name here but I cannot figure out what.
Does not need to be this method of solving, this is just what I currently have.
I am opening multiple files which is why I mostly use ActiveSheet methods not Sheet1 Sheet2. The file that my code is in is called "masterfile.xls"
Any help is greatly appreciated!!
Previous code outline help found here: Search for specific column header names, copy columns and paste to append to another wookbooksheet
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
Dim LastRow As Integer, erow 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
Dim k As Long
Dim width As Long
Dim ws As Worksheet
Dim TOOLList As Object
Dim count As Long
Set TOOLList = CreateObject("Scripting.Dictionary")
' search for all tel/number list on other sheets
' Assuming header means Row 1
For Each ws In Worksheets
If Sht <> "masterfile.xls" Then
With ActiveSheet
.Activate
width = .Cells(10, .Columns.count).End(xlToLeft).Column
For k = 1 To width
If Trim(.Cells(10, k).Value) = "CUTTING TOOL" Then
Height = .Cells(.Rows.count, k).End(xlUp).Row
If Height > 1 Then
For j = 2 To Height
If Not TOOLList.exists(.Cells(j, k).Value) Then
TOOLList.Add .Cells(j, k).Value, ""
End If
Next j
End If
End If
Next
End With
End If
Next
' paste the TOOL list found back to this sheet
With masterfile.xls
.Activate
width = .Cells(10, .Columns.count).End(xlToLeft).Column
For k = 1 To width
If Trim(.Cells(10, k).Value) = "CUTTING TOOL" Then
Height = .Cells(.Rows.count, k).End(xlUp).Row
count = 0
For Each TOOL In TOOLList
count = count + 1
.Cells(Height + count, k).Value = TOOL
Next
End If
Next
End With
'Range("J1").Select
'Selection.Copy
'Windows("masterfile.xlsm").Activate
'Range("D2").Select
'ActiveSheet.Paste
ActiveWorkbook.Close SaveChanges:=False
Next objFile
'Application.ScreenUpdating = True
End Sub
Sht
is a reference to a worksheet object. You're comparing it to a string which looks like the name of a workbook. Presumably you're trying to check if the active sheet has a specific name in which case you could useIf Sht.Name <> "Some Name" Then
. Alternatively, if you're trying to check whether Sht is not part of the workbook "masterfile.xls" then you could useIf Sht.Parent.Name <> "masterfile" Then
. – 314UnreadEmails