Tay*_*lor 2 excel vba header copy-paste excel-vba
如何使用这些列标题名称"TOOL CUTTER"和"HOLDER"复制列(仅限数据)并将它们(作为一个附加在一个列中,每个列具有相同的列标题名称)粘贴到另一个工作簿表中,其中VBA代码(表格模块)是.谢谢.
该行"If Sht <> "masterfile.xls" Then是问题发生的地方.我得到了另一个在线来源的帮助,这条线If ws.name <> me.name Then显然我本来想在这里写一个不同的名字,但我无法弄清楚是什么.
不需要这种解决方法,这正是我现在所拥有的.
我打开多个文件,这就是为什么我主要使用ActiveSheet方法而不是Sheet1 Sheet2.我的代码所在的文件名为"masterfile.xls"
任何帮助是极大的赞赏!!
在此处找到以前的代码大纲帮助:搜索特定列标题名称,复制列并粘贴以附加到另一个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 指的是此代码所在的工作簿中的活动工作表,因为 Set Sht = ActiveSheet
sht 是一个对象变量,永远不会等于字符串值 "masterfile.xls"
sht.name将为您提供工作表的(字符串)名称,您可以将其与字符串值进行比较"masterfile.xls",但仍然不会告诉您您的目的是什么,因为:
WorkSheet(sht.name用的文件名)WorkBook(masterfile.xls).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事实并非如此.它不是一个字符串(没有引号),它不是任何类型的变量(从未声明),它不是具有方法或属性(xls)的对象(masterfile).这表示您没有Option Explicit设置代码顶部.您应该始终这样做,因为它会使这成为编译时错误而不是运行时错误.ActiveWorkbook.Close SaveChanges:=False会关闭你正在运行的工作簿,因为你已经激活它.尝试这个代码,它可能不是100%,至少应该让你更接近你所追求的:
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