您可以将“如果找到则复制列”拆分为单独的子列：

Sub CopyColumns()

    Dim wsSource, wsResult As Worksheet
    
    Set wsSource = ThisWorkbook.Sheets("Source")
    Set wsResult = ThisWorkbook.Sheets("Result")
    
    CopyIfExists wsSource.Rows(1), "#BASEDATA#name", wsResult, 3
    CopyIfExists wsSource.Rows(1), "#BASEDATA#uniqueId", wsResult, 4
    CopyIfExists wsSource.Rows(1), "#BASEDATA#operatingStatus", wsResult, 1
    
End Sub

'Look for `colName` in `headerRow`, and if found copy the whole
'  column to column `destColNum` on `destSheet`
Sub CopyIfExists(headerRow As Range, colName As String, destSheet As Worksheet, destColNum As Long)
    Dim f As Range
    Set f = headerRow.Find(what:=colName, lookat:=xlWhole) 'or xlPart
    If Not f Is Nothing Then
        f.EntireColumn.Copy destSheet.Cells(1, destColNum)
    End If
End Sub

使用find时，在尝试对匹配的单元格执行任何操作之前，应该检查是否找到了匹配项。

复制列

Option Explicit

Sub CopyColumnsToResult()

    Dim sColNames(): sColNames = Array("#BASEDATA#name", _
        "#BASEDATA#uniqueId", "#BASEDATA#operatingStatus")
    Dim dCols(): dCols = Array(3, 4, 1)

    Dim sws As Worksheet: Set sws = ThisWorkbook.Sheets("Source")
    Dim shrg As Range: Set shrg = sws.Rows(1)
    Dim slCell As Range: Set slCell = shrg.Cells(shrg.Cells.Count) ' last cell
    
    Dim dws As Worksheet: Set dws = ThisWorkbook.Sheets("Result")
    
    Dim shCell As Range, c As Long
    
    For c = LBound(sColNames) To UBound(sColNames)
        Set shCell = shrg.Find(sColNames(c), slCell, xlFormulas, xlWhole)
        If Not shCell Is Nothing Then ' header cell found
            sws.Columns(shCell.Column).Copy dws.Columns(dCols(c))
        End If
    Next c
    
    MsgBox "Columns copied.", vbInformation
    
End Sub