根据你的需求，以下是使用VBA按单位名称拆分工作簿的详细步骤和示例代码：

一、拆分规则说明

拆分依据：

以A列（单位名称）为基准，将数据按单位名称复制到独立工作簿；

保留数据：

拆分后的工作簿需保留原工作表的黄色背景表头；

命名规则：

新工作簿命名为“单位名称+已追缴工程款合计数”；

路径要求：

新工作簿存放路径与原工作簿一致。

二、VBA实现步骤

禁用屏幕更新和提示

通过`Application.ScreenUpdating = False`和`Application.DisplayAlerts = False`提升代码运行效率，避免操作提示干扰。

获取原工作簿路径

检查当前工作簿路径，若路径以反斜杠结尾则补全路径分隔符。

读取数据范围

确定数据起始行（如第6行）和结束行（如数据的最后一行），并读取A列数据到数组中。

创建新工作簿并复制数据

遍历A列每个单位名称，为每个单位创建新工作簿，并将对应行的数据复制过去。

设置新工作簿名称

根据单位名称和已追缴工程款合计数生成新工作簿名称。

三、示例代码

```vba

Sub SplitWorkbookByUnit()

Dim ws As Worksheet

Dim p As String

Dim lastRow As Long

Dim i As Long

Dim arr() As Variant

Dim wb As Workbook

Dim titleRow As Range

Dim newBookName As String

' 禁止屏幕更新和提示

Application.ScreenUpdating = False

Application.DisplayAlerts = False

' 获取当前工作簿路径

p = ThisWorkbook.Path

If Right(p, 1) <> "\" Then p = p & "\" ' 补全路径分隔符

' 设置数据范围（假设数据从第6行开始）

Set ws = ThisWorkbook.Sheets(1)

lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

Set titleRow = ws.Rows(1:5) ' 假设前5行为表头

arr = ws.Range(titleRow, ws.Cells(lastRow, 1)).Value

' 遍历每个单位名称并拆分

For i = 6 To lastRow

newBookName = arr(i, 1) & "-" & WorksheetFunction.Sum(arr(i, 2:15))

Workbooks.Add

ws.Rows(i).Copy Destination:=Worksheets(Worksheets.Count).Range("A1")

Worksheets(Worksheets.Count).Name = newBookName

Next i

' 恢复屏幕更新和提示

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

```

四、注意事项

数据验证：

拆分前建议备份原数据，避免数据覆盖或丢失；

路径权限：

确保目标路径存在且可写；

名称冲突：

若存在同名工作簿，需修改命名规则或手动处理。

五、补充说明

若数据量较大，建议优化代码或使用Excel的“文本分列”功能（适用于静态数据拆分）；

以上代码假设表头为前5行，若表头行数不同需调整`titleRow`的设置。

通过以上步骤，你可以高效地按单位名称拆分工作簿，并保持数据完整性和一致性。