Excel如何根据首列A列值选取对应单元格区域并跨表复制

直接用以下VBA脚本即可完成需求，不需要手动逐块选区域复制：

• 打开待处理的Excel文件，按Alt+F11调出VBA编辑器
• 在左侧工程资源管理器右键点击当前工作簿，选择「插入」>「模块」
• 将下方代码粘贴到模块编辑窗口，按F5即可运行

Sub SplitDataByLocation()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRow As Long, i As Long, blockStart As Long, blockEnd As Long
    Dim locName As String, nextRowA As Long, nextRowG As Long
    
    ' 运行脚本前请先激活原始数据表
    Set wsSource = ActiveSheet
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    blockStart = 1
    
    For i = 2 To lastRow + 1
        ' 匹配Location标识识别分块边界，处理到最后一行自动收尾
        If i = lastRow + 1 Or InStr(Trim(wsSource.Cells(i, "A").Value), "Location") = 1 Then
            blockEnd = i - 1
            locName = Trim(wsSource.Cells(blockStart, "A").Value)
            
            ' 无对应名称工作表则自动新建
            On Error Resume Next
            Set wsTarget = ThisWorkbook.Worksheets(locName)
            On Error GoTo 0
            If wsTarget Is Nothing Then
                Set wsTarget = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
                wsTarget.Name = locName
            End If
            
            ' 复制B-E列分块数据，追加到目标表A列空白位置
            nextRowA = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
            If nextRowA = 2 And wsTarget.Cells(1, "A").Value = "" Then nextRowA = 1
            wsSource.Range("B" & blockStart & ":E" & blockEnd).Copy
            wsTarget.Range("A" & nextRowA).PasteSpecial xlPasteAll
            
            ' 复制H列分块数据，追加到目标表G列空白位置
            nextRowG = wsTarget.Cells(wsTarget.Rows.Count, "G").End(xlUp).Row + 1
            If nextRowG = 2 And wsTarget.Cells(1, "G").Value = "" Then nextRowG = 1
            wsSource.Range("H" & blockStart & ":H" & blockEnd).Copy
            wsTarget.Range("G" & nextRowG).PasteSpecial xlPasteAll
            
            blockStart = i
            Set wsTarget = Nothing
        End If
    Next i
    Application.CutCopyMode = False
    MsgBox "数据拆分完成"
End Sub

注意事项 #

• 脚本自动识别A列所有以Location开头的分块，不需要手动写死每块的行数，新增Location区域也能正常适配
• 若同名工作表已存在，数据会自动追加到现有内容下方，不会覆盖原有数据
• 默认粘贴保留原格式、公式，若只需要粘贴数值，把代码中xlPasteAll替换为xlPasteValues即可
• 运行前务必先选中存放原始数据的工作表，避免取错数据源

附示例表格参考：

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