基于@chrisneilsen的解决方案，这里有一个更紧凑的代码：

Option Explicit

Public Sub myImport()
    Dim sPathName As String, sFileName As String
    Dim targetSht As Worksheet

    Set targetSht = ActiveWorkbook.Worksheets("Master UTP")

    sPathName = ThisWorkbook.Path & "\"
    sFileName = Dir(sPathName & "*.xls", vbNormal)

    Do While Len(sFileName) > 0
        If sFileName <> targetSht.Parent.Name Then
            On Error Resume Next
            With Workbooks.Open(sPathName & sFileName)
                .Sheets("UTP").Copy After:=targetSht
                .Close False
            End With
            On Error GoTo 0
        End If
        sFileName = Dir
    Loop
End Sub

如果可以安全地假设ActiveWorkbook是“宏”的话，则其应该甚至稍微更紧凑，即，在它的名字中有一个“xlsm”类型，所以它永远不能匹配任何“xls”名字：

Option Explicit

Public Sub myImport()
    Dim sPathName As String, sFileName As String
    Dim targetSht As Worksheet

    Set targetSht = ActiveWorkbook.Worksheets("Master UTP")

    sPathName = ThisWorkbook.Path & "\"
    sFileName = Dir(sPathName & "*.xls", vbNormal)

    Do While Len(sFileName) > 0
        On Error Resume Next
        With Workbooks.Open(sPathName & sFileName)
            .Sheets("UTP").Copy After:=targetSht
            .Close False
        End With
        On Error GoTo 0
        sFileName = Dir
    Loop
End Sub

最后，您可以在打开任何xls文件时消除 Flink ，因此您可以将循环包含在Application.ScreenUpdating = False/True语句中：

Option Explicit

Public Sub myImport()
    Dim sPathName As String, sFileName As String
    Dim targetSht As Worksheet

    Set targetSht = ActiveWorkbook.Worksheets("Master UTP")

    sPathName = ThisWorkbook.Path & "\"
    sFileName = Dir(sPathName & "*.xls", vbNormal)

    Application.ScreenUpdating = False
    Do While Len(sFileName) > 0
        On Error Resume Next
        With Workbooks.Open(sPathName & sFileName)
            .Sheets("UTP").Copy After:=targetSht
            .Close False
        End With
        On Error GoTo 0
        sFileName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

第一个问题是您尝试打开sName而不是sFileName（使用Option Explicit将检测到此错误）
第二个问题，您正在将字符串与If sFileName <> sourceWb Then中的工作簿进行比较
第三个问题，workbook.name不包含路径
您的代码，重构，并添加了一些错误处理

Public Sub myImport()
    Dim sPathName As String, sFileName As String
    Dim sourceWb As Workbook, targetWb As Workbook
    Dim ws As Worksheet

    Set sourceWb = ActiveWorkbook

    sPathName = ThisWorkbook.Path & "\"
    sFileName = Dir(sPathName & "*.xls", vbNormal)

    Do While Len(sFileName) > 0
        If sFileName <> sourceWb.Name Then ' <-- sourceWb.Name does not include path
            Set targetWb = Nothing
            On Error Resume Next ' <-- in case Open fails
                Set targetWb = Workbooks.Open(sPathName & sFileName) '<-- use correct variable sFileName
            On Error GoTo 0
            If Not targetWb Is Nothing Then
                Set ws = Nothing
                On Error Resume Next ' <-- in case sheet does not exist
                    Set ws = targetWb.Worksheets("UTP")
                On Error Resume Next
                If Not ws Is Nothing Then
                    ws.Copy After:=sourceWb.Worksheets("Master UTP")
                End If
                targetWb.Close False 
            End If
        End If

        sFileName = Dir
    Loop
End Sub

代码看起来很好，除了在尝试打开其他工作簿时出现错误。您尝试从从未使用过的变量sName打开工作簿。您还不必要地重置了sFileName变量，而是尝试使用sPathName & sFileName作为Workbooks.Open()的输入。
此外，您尝试比较sFileName和sourceWb这两种不同的数据类型，而不是比较sFileName和sourceWb.Name。
最后，假设工作簿将有一个名为"UTP"的工作表，如果没有，代码将崩溃。而是先检查表是否存在。查看https://stackoverflow.com/a/6040390/8520655了解更多信息。
请看下面的例子; Public Sub myImport（）Dim sPathName As String，sFileName As String Dim sourceWb As Workbook，targetWb As Workbook

Set sourceWb = ActiveWorkbook
ActiveSheet.Cells(1, 1).Value = sourceWb.Name

sPathName = ThisWorkbook.Path & "\"
sFileName = Dir(sPathName & "*.xls", vbNormal)

Do While Len(sFileName) > 0
    ActiveSheet.Cells(1, 2).Value = sFileName
    If sFileName <> sourceWb.Name Then
        Set targetWb = Workbooks.Open(sPathName & sFileName)

        If SheetExists("UTP", targetWb) Then
            targetWb.Sheets("UTP").Copy After:=sourceWb.Sheets("Master UTP")
        End If

        targetWb.Close
    End If

    sFileName = Dir
Loop
End Sub

Function SheetExists(SheetName As String, Optional wb As Excel.Workbook)
    Dim s As Excel.Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set s = wb.Sheets(SheetName)
    On Error GoTo 0
    SheetExists = Not s Is Nothing
End Function

Sub ImportFirstSheet（）Dim filePath As Variant Dim wb Source As Workbook Dim wsSource As Worksheet Dim wsDestination As Worksheet Dim destRange As Range

' Prompt the user to select the source workbook
filePath = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")

' Check if a file was selected
If filePath <> False Then
    ' Open the source workbook
    Set wbSource = Workbooks.Open(filePath)
    
    ' Set the source worksheet (the first sheet)
    Set wsSource = wbSource.Sheets(1)
    
    ' Set the destination worksheet (the active sheet)
    Set wsDestination = ThisWorkbook.ActiveSheet
    
    ' Clear existing contents in the destination worksheet starting from cell B1
    wsDestination.Range("A2").CurrentRegion.Clear
    
    ' Copy the data from the source worksheet to the destination worksheet
    wsSource.UsedRange.Copy
    
    ' Paste the data to the destination worksheet starting from cell B1
    Set destRange = wsDestination.Range("A2")
    destRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ' Close the source workbook without saving changes
    wbSource.Close SaveChanges:=False
    
    ' Inform the user that the import is complete
    MsgBox "Import complete.", vbInformation
Else
    ' Inform the user that no file was selected
    MsgBox "No file selected.", vbExclamation
End If

结束子
Sub HighlightCellsContainingSearchString（）Dim searchString As String Dim searchRange As Range Dim cell As Range

' Prompt the user to enter the search string
searchString = InputBox("Enter the search string:", "Search String")

' Check if the search string is entered
If Len(searchString) > 0 Then
    ' Set the search range as the active sheet
    Set searchRange = ActiveSheet.UsedRange
    
    ' Clear previous highlighting
    searchRange.Interior.ColorIndex = xlNone
    
    ' Loop through each cell in the search range
    For Each cell In searchRange
        ' Check if the cell value contains the search string
        If InStr(1, cell.Value, searchString, vbTextCompare) > 0 Then
            ' Highlight the cell
            cell.Interior.Color = RGB(255, 0, 0) ' Change the RGB values to the desired highlight color
        End If
    Next cell
    
    ' Inform the user that the highlighting is complete
    MsgBox "Highlighting complete.", vbInformation
Else
    ' Inform the user that no search string was entered
    MsgBox "No search string entered.", vbExclamation
End If

结束子