VBA自动检查文件夹下所有excel表格，如果表格内x列存在关键字主水泵，就将这x列复制到当前表格x列，如果表格内y列存在关键字主水泵，就将这y列复制到当前表格x列，以此类推，若当前表格对应列已经有数据，则从对应列最后单元格再往下填充数据

在VBA中，为了实现这样的功能，你需要对之前的代码进行一些调整。首先，我们需要一个数组来存储每种关键字对应的列索引（X、Y等），然后根据找到的关键字动态更新目标列。以下是修改后的代码示例：

Sub CheckAndCopyColumns()
    Dim ws As Worksheet
    Dim filePath As String
    Dim file As Object, fso As Object, folder As Object, excelApp As Object
    Dim foundColumnDict As Scripting.Dictionary
    Dim foundColumn As Long, lastRow As Long, keyword As Variant
    
    ' 初始化变量和字典
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder("<你的文件夹路径>")
    Set excelApp = CreateObject("Excel.Application")
    Set foundColumnDict = New Scripting.Dictionary
    foundColumnDict.Add "主水泵", 1 ' 示例：主水泵对应X列，其他关键字替换为相应的列编号

    ' 遍历文件夹中的所有Excel文件
    For Each file In folder.Files
        If Right(file.Name, 4) = ".xlsx" Or Right(file.Name, 4) = ".xls" Then
            ' 打开文件和工作簿
            Set excelApp = CreateObject("Excel.Application")
            excelApp.Visible = False
            Set workbook = excelApp.Workbooks.Open(file.Path)

            ' 检查每个工作表
            For Each ws In workbook.Worksheets
                For Each keyword In foundColumnDict.Keys ' 遍历关键字
                    ' 查找列
                    foundColumn = ws.Cells.Find(What:=keyword, LookIn:=xlValues, LookAt:=xlWhole).Column
                    If Not IsError(foundColumn) Then
                        ' 检查目标列是否存在数据，如有则从最后一行开始填充
                        lastRow = ws.Cells(ws.Rows.Count, foundColumn).End(xlUp).Row
                        If Not ws.Cells(lastRow, foundColumn).IsError And Not ws.Cells(lastRow, foundColumn).Value = "" Then
                            ' 从已有数据的最后一行开始填充
                            ws.Cells(lastRow + 1, foundColumn).Resize(ws.Rows.Count - lastRow).Value = ws.Range(ws.Cells(1, foundColumn), ws.Cells(ws.Rows.Count, foundColumn))
                        Else
                            ' 直接复制
                            ws.Range(ws.Cells(1, foundColumn), ws.Cells(ws.Rows.Count, foundColumn)).Copy _
                                ActiveWorkbook.Sheets(ActiveSheet.Index).Range("A" & foundColumnDict(keyword)) ' 例如："A1" -> "X1"
                        End If
                    End If
                Next keyword
            Next ws

            ' 关闭文件
            workbook.Close SaveChanges:=True
            Set workbook = Nothing
            excelApp.Quit
            Set excelApp = Nothing
        End If
    Next file

    ' 清理内存
    Set fso = Nothing
    Set folder = Nothing
End Sub

记得替换 `<你的文件夹路径>` 和根据实际需求修改关键字与对应列的映射。