如何拆分总表行数据分成多个独立报表文件？感谢！

cx1431

总表有总的回访信息，每个人每年最多回访12次。总表表头部分固定，列固定；分表格式固定。
1、新表含每个人的基本信息，每个人有12次回访，不管是否有值，都复制到新工作簿。2、新工作簿格式固定
3、新工作簿文件名为”编号姓名”

3190496160

1、这是vba才能做的事情，
2、不难，但是比较繁琐，先留个足印吧

3190496160

Sub 拆分为工作簿()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim br()
ar = Sheets("信息汇总表").[a1].CurrentRegion
For i = 5 To UBound(ar)
    n = 0
    ReDim br(1 To UBound(ar, 2), 1 To 9)
    If Trim(ar(i, 3)) <> "" Then
        For j = 9 To UBound(ar, 2) Step 9
            m = 0
            If Trim(ar(i, j)) <> "" Then
                n = n + 1
                For s = j To j + 8
                    m = m + 1
                    br(n, m) = ar(i, s)
                Next s
            End If
        Next j
        Sheets("模板").Copy
        Set wb = ActiveWorkbook
        With wb.Worksheets(1)
            .Name = ar(i, 3)
            .[b2] = ar(i, 1)
            .[d2] = ar(i, 3)
            .[f2] = ar(i, 4)
            .[h2] = ar(i, 5)
            .[j2] = ar(i, 6)
            .[l2] = ar(i, 7)
            .[n2] = ar(i, 8)
            .[b5].Resize(n, UBound(br, 2)) = br
        End With
        wb.SaveAs Filename:=ThisWorkbook.Path & "\" & ar(i, 1) & "_" & ar(i, 3)
        wb.Close
    End If
Next i
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

台账折分.rar (17.96 KB, 下载次数: 3)

2021-10-9 08:45 上传

点击文件名下载附件

3190496160

结果未经核对，代码仅供参考，主要是你的模板太多合并单元格

cx1431

3190496160 发表于 2021-10-9 08:45

大神，您好，有几列没有对上，能帮调整一下吗？

cx1431

3190496160 发表于 2021-10-9 08:46
结果未经核对，代码仅供参考，主要是你的模板太多合并单元格

因为模板有合并单元格的情况，可能这个原因导致引用数据出现漏的情况。

cx1431

3190496160 发表于 2021-10-9 08:46
结果未经核对，代码仅供参考，主要是你的模板太多合并单元格

大神，你好。我的账号等级还不能加好友。