search特定的列标题，复制列并粘贴到另一个工作簿

如何将这些列标题名称“TOOL CUTTER”和“HOLDER”复制到列表（只有数据），然后将其粘贴到另一个工作簿表单中，其中VBA代码（Sheet Module）是。 谢谢。

"If Sht <> "masterfile.xls" Then是问题发生的地方，我从另一个在线源获得帮助If ws.name <> me.name Then显然我打算在这里放一个不同的名字但我无法弄清楚什么。

不需要成为这种解决方法，这正是我目前所拥有的。

我打开多个文件，这就是为什么我主要使用ActiveSheet方法而不是Sheet1 Sheet2。 我的代码所在的文件被称为“masterfile.xls”

任何帮助是极大的赞赏！！

先前的代码大纲帮助在这里find： search特定的列标题名称，复制列和粘贴到追加到另一个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 

Answer 1

• sht是指代码所在工作簿中的活动工作表，因为Set Sht = ActiveSheet

• sht是一个对象variables，永远不会等于string值"masterfile.xls"

• sht.name会给你工作表的名称（string），你可以将它与string值"masterfile.xls"进行比较，但是仍然不会告诉你你在做什么，因为：

  • 您将WorkSheet （ sht.name ）的名称与WorkBook的文件名称（ masterfile.xls ） WorkBook 。

• If LCase(Right(objFile.Name, 3)) <> "xls" And Case(Left(Right(objFile.Name, 4), 3)) <> "xls" Then Else是一个非常尴尬的构造。 将其更改为：

  • If LCase(Right(objFile.Name, 3)) = "xls" or Case(Left(Right(objFile.Name, 4), 3)) = "xls" Then删除else子句。 它会使它更可读

• 我认为If Sht <> "masterfile.xls" Then打算跳过WorkBook masterfile.xls的处理，如果是这样的话：

  • If Sht.Cells(i, 1) <> "masterfile.xls" Then应该做的伎俩，因为你在你的代码中存储文件名称。 （注意：你在使用后立即增加i ，所以你必须在这里使用一个较小的值。）
• Workbooks.Open fileName:=MyFolder & objFile.Name将打开新的工作簿，但是使您很容易混淆正在查看的工作簿。 尝试Set NewWb = Workbooks.Open fileName:=MyFolder & objFile.Name ，现在你有一个坚实的句柄来引用这个。
• With ActiveSheet .Activate简直是多余的。 ActiveSheet是活动工作表，不需要激活它。
• With masterfile.xls是一个完全不起作用的语句。 With期待某种集合对象来处理，而masterfile.xls不是。 它不是一个string（不是引号），它不是任何types的variables（从来没有声明），它不是一个方法或属性（xls）的对象（masterfile）。 这表示您没有在代码顶部设置Option Explicit 。 您应该始终这样做，因为这会导致编译时错误，而不是运行时错误。
• 如果上面的工作， ActiveWorkbook.Close SaveChanges:=False将closures您正在运行的工作簿，因为您将激活它。

试试这个代码，它可能不是100％，它应该至less让你更接近你以后的东西：

 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