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
refers to the active worksheet in the workbook in which this code resides, because Set Sht = ActiveSheet
sht
is an object variable, and will never be equal to the string value "masterfile.xls"
sht.name
will give you the (string) name of the worksheet which you could compare to the string value "masterfile.xls"
, but that still won't tell you what you're after because:
WorkSheet
( sht.name
) with the file name of the WorkBook
( masterfile.xls
). If LCase(Right(objFile.Name, 3)) <> "xls" And Case(Left(Right(objFile.Name, 4), 3)) <> "xls" Then Else
is a very awkward construct. Change that to:
If LCase(Right(objFile.Name, 3)) = "xls" or Case(Left(Right(objFile.Name, 4), 3)) = "xls" Then
and eliminate the else
clause. it will make it much more readable I presume that If Sht <> "masterfile.xls" Then
is intended to skip the processing of the WorkBook masterfile.xls
if that's the case then:
If Sht.Cells(i, 1) <> "masterfile.xls" Then
should do the trick, since you stored the file name earlier in your code. (Note: you immediately increment i
after using it, so you have to use one smaller value here.) Workbooks.Open fileName:=MyFolder & objFile.Name
will open the new workbook, but makes it too easy to get confused on which workbook you're looking at. Try Set NewWb = Workbooks.Open fileName:=MyFolder & objFile.Name
, now you have a firm handle with which to reference this one. With ActiveSheet .Activate
is simply redundant. ActiveSheet
is the active sheet, there's no need to activate it. With masterfile.xls
is a totally non-functional statement. With
is expecting some sort of collection object to work with, which masterfile.xls
is not. It's not a string (no quotes), it's not a variable of any sort (never declared), it's not an object (masterfile) with a method or property (xls). This indicates that you don't have Option Explicit
set at the top of your code. You should always do this, as it will make this a compile-time error instead of a run-time error. ActiveWorkbook.Close SaveChanges:=False
would have closed the workbook you're running from, because you would have activated it. Try this code, it's probably not 100%, it should at least get you closer to what you're after:
Option Explicit
Sub LoopThroughDirectory()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim MyFolder As String
Dim StartSht As Worksheet
Dim i As Integer
Dim LastRow As Integer, erow As Integer
MyFolder = "C:\Users\trembos\Documents\TDS\progress\"
Set StartSht = ActiveSheet
'create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'get the folder object
Set objFolder = objFSO.GetFolder(MyFolder)
i = 2
'loop through directory file and print names
For Each objFile In objFolder.Files
If LCase(Right(objFile.Name, 3)) = "xls" Or LCase(Left(Right(objFile.Name, 4), 3)) = "xls" Then
'print file name
StartSht.Cells(i, 1) = objFile.Name
Dim NewWb As Workbook
Set NewWb = 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
If objFile.Name <> "masterfile.xls" Then 'skip any processing on "Masterfile.xls"
For Each ws In NewWb.Worksheets 'assuming we want to look through the new workbook
With ws
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
Next
End If
' paste the TOOL list found back to this sheet
With StartSheet
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
NewWb.Close SaveChanges:=False
i = i + 1
Next objFile
'Application.ScreenUpdating = True
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.