有位网友问到:如何将一个如下图所示的Excel工作表，按户拆分成多个sheet表? 如何把一个excel工作薄按一定格式拆分为多个sheet表，这是一个Excel操作中比较常见的问题。如果原表行数比较少，我们可以直接手工分拆；但当数据量比较大时，可以使用编程的方式来自动实现，这里我们用Excel内置的VBA来实现自动分拆。

根据题意可见，每张分表都具有相同的结构。我们可以先按此表格结构创建一个模板工作表（这里命名为Template）,如下图所示：

基本思想是：从sheet1源表获得户主个数及姓名，复制Template表为一个新的工作表，并以户主姓名命名，然后逐个读取sheet1表中的数据填入到此相应的工作表中，这样每户信息形成了一张新的工作表，实现了原工作表的分拆。

我们可以用VBA宏来实现此操作。下面是用VBA宏来实现的的详细步骤，包括如何编写VBA代码来实现这一操作。

一、 打开Excel并启用开发者选项

首先，打开含有需要合并工作表的Excel工作簿。如果“开发者”选项卡未显示，请点击“文件” > “选项” > “自定义功能区”，在右侧勾选“开发者”复选框，然后点击“确定”。

二、 插入VBA模块

转到“开发者”选项卡，点击“Visual Basic”或者直接按【Alt + F11】组合键打开VBA编辑器。然后在VBA项目浏览器中（通常位于左侧），右击工作簿名，选择“插入” > “模块”,创建一个新的模块，用于编写VBA代码。

三、 编写VBA代码

在新插入的模块中，粘贴以下VBA代码。

Sub CopyRangeToAnotherSheet(srcShName, destShName, range1, range2) Dim sourceSheet As Worksheet Dim destinationSheet As Worksheet Dim sourceRange As Range Dim destinationRange As Range ' 设置源工作表和目标工作表 Set sourceSheet = ThisWorkbook.Worksheets(srcShName) Set destinationSheet = ThisWorkbook.Worksheets(destShName) ' 设置要复制的源单元格区域和目标单元格区域 ' 假设要复制Sheet1的A1:B10到Sheet2的A1位置 Set sourceRange = sourceSheet.Range(range1) Set destinationRange = destinationSheet.Range(range2) ' 复制并粘贴单元格区域 sourceRange.Copy Destination:=destinationRangeEnd SubSub myCopy() ' 调用CopyRangeToAnotherSheet子程序，逐个复制每户信息到相应工作表 Dim ws As Worksheet totalRow = Range("A65536").End(xlUp).Row + 1 num = totalRow \ 15 '户数 For k = 1 To num '获取户主姓名 mainName = Sheets("Sheet1").Cells((k - 1) * 15 + 4, 3).Value '复制模板工作表到新工作表，并以户主姓名命名 Sheets("Template").Copy After:=Sheets(Sheets.Count) Set ws = Sheets(Sheets.Count) ws.Name = mainName '复制原表sheet1中相应信息到新添加的工作表中 Offset = (k - 1) * 15 range1 = "A" & (Offset + 1) & ":E" & (Offset + 11) Call CopyRangeToAnotherSheet("sheet1", mainName, range1, "A1") NextEnd Sub

四、运行VBA宏

返回Excel界面，再次点击“开发者”选项卡，点击“宏”。 在弹出的“宏”对话框中，选择myCopy，然后点击“运行”，即可实现原工作表的分拆。

最终得到自动分拆后的工作表，如下图示：

但这里需要注意的是：原sheet1中每户信息的结构要保持相同。

我是鉴水鱼老师，关注我，持续分享更多的Excel知识和操作技能。