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

Question

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

Answer 1

• 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:

  • You're confusing the name of the 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.
• If the above had worked, 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