Excel VBA需求：将含指定值的动态数据行复制至对应工作表

你提到的XLOOKUP仅能返回首行匹配数据，确实无法满足批量拆分的需求。以下是直接可用的VBA脚本，能自动将J列中指定值对应的整行数据复制到独立工作表，适配每周更新的动态数据集：

Sub SplitDataByColumnJ()
    Dim sourceSheet As Worksheet
    Dim targetSheetX As Worksheet
    Dim targetSheetY As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim nextRowX As Long
    Dim nextRowY As Long
    
    ' 指定源数据所在工作表（根据实际修改）
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    
    ' 检查目标工作表是否存在，不存在则自动新建
    On Error Resume Next
    Set targetSheetX = ThisWorkbook.Worksheets("Sheet2")
    If Err.Number <> 0 Then
        Set targetSheetX = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        targetSheetX.Name = "Sheet2"
    End If
    On Error GoTo 0
    
    On Error Resume Next
    Set targetSheetY = ThisWorkbook.Worksheets("Sheet3")
    If Err.Number <> 0 Then
        Set targetSheetY = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        targetSheetY.Name = "Sheet3"
    End If
    On Error GoTo 0
    
    ' 自动复制表头到空的目标工作表
    If targetSheetX.Cells(1, 1).Value = "" Then
        sourceSheet.Rows(1).Copy Destination:=targetSheetX.Rows(1)
    End If
    If targetSheetY.Cells(1, 1).Value = "" Then
        sourceSheet.Rows(1).Copy Destination:=targetSheetY.Rows(1)
    End If
    
    ' 获取源数据的最后一行行号（适配动态数据）
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "J").End(xlUp).Row
    
    ' 遍历所有数据行（从第2行开始跳过表头）
    For i = 2 To lastRow
        ' 根据J列值判断复制目标
        Select Case sourceSheet.Cells(i, "J").Value
            Case "X"
                nextRowX = targetSheetX.Cells(targetSheetX.Rows.Count, "A").End(xlUp).Row + 1
                sourceSheet.Rows(i).Copy Destination:=targetSheetX.Rows(nextRowX)
            Case "Y"
                nextRowY = targetSheetY.Cells(targetSheetY.Rows.Count, "A").End(xlUp).Row + 1
                sourceSheet.Rows(i).Copy Destination:=targetSheetY.Rows(nextRowY)
            ' 如需添加其他类别，直接追加Case即可
            ' Case "Z"
            '     nextRowZ = targetSheetZ.Cells(targetSheetZ.Rows.Count, "A").End(xlUp).Row + 1
            '     sourceSheet.Rows(i).Copy Destination:=targetSheetZ.Rows(nextRowZ)
        End Select
    Next i
    
    MsgBox "数据拆分完成！", vbInformation
End Sub

使用说明： #

1. 打开Excel文件，按Alt+F11打开VBA编辑器
2. 右键点击左侧工作簿名称 → 插入 → 模块，将代码粘贴到模块中
3. 根据实际情况修改：
   • 源工作表名称（如果不是Sheet1）
   • J列的目标值（比如"X"、"Y"）和对应的目标工作表名称
   • 如需处理更多类别，直接在Select Case中追加新的Case分支
4. 按F5运行宏，或在Excel界面的「开发工具」选项卡中找到对应宏执行

注意事项： #

• 目标工作表已有数据时，新数据会自动追加在现有内容下方
• 若J列值存在空格或大小写差异，可将判断条件改为UCase(Trim(sourceSheet.Cells(i, "J").Value))统一格式
• 建议先备份数据再运行宏，避免误操作

内容的提问来源于stack exchange，提问作者Blarn