VBA从多个文件复制知道关键字的列

Sub CopyColumnsWithKeyword()
    Dim keyword As String
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim targetWorksheet As Worksheet
    Dim sourceColumn As Range
    Dim targetColumn As Range
    
    ' 设置关键字
    keyword = "关键字"
    
    ' 打开源文件
    Set sourceWorkbook = Workbooks.Open("源文件路径")
    ' 打开目标文件
    Set targetWorkbook = Workbooks.Open("目标文件路径")
    
    ' 设置源工作表和目标工作表
    Set sourceWorksheet = sourceWorkbook.Worksheets("源工作表名称")
    Set targetWorksheet = targetWorkbook.Worksheets("目标工作表名称")
    
    ' 查找包含关键字的列
    Set sourceColumn = sourceWorksheet.Rows(1).Find(keyword, LookIn:=xlValues, LookAt:=xlWhole)
    
    ' 复制列到目标工作表
    If Not sourceColumn Is Nothing Then
        sourceWorksheet.Columns(sourceColumn.Column).Copy Destination:=targetWorksheet.Cells(1, 1)
    Else
        MsgBox "未找到包含关键字的列。"
    End If
    
    ' 关闭文件
    sourceWorkbook.Close SaveChanges:=False
    targetWorkbook.Close SaveChanges:=True
    
    ' 释放对象
    Set sourceColumn = Nothing
    Set sourceWorksheet = Nothing
    Set sourceWorkbook = Nothing
    Set targetColumn = Nothing
    Set targetWorksheet = Nothing
    Set targetWorkbook = Nothing
End Sub