一个工作簿中有多个工作表，如何将其中一个工作表按条件（姓名）拆分成多个工作簿...

yq1163022574

求助大神：一个工作簿中有多个工作表，如何将其中一个工作表按条件（姓名）拆分成多个工作簿，并且其他表不变。（注意该工作簿有多个工作表，不只3张表）。原工作簿：
拆分后的工作簿：

heathop

论坛很多这样基础操作案例，找找看

约定的童话

拆分成工作簿邮件发送？

3190496160

Sub chaifen()
Dim sh As Sheet1, rng As Range
Set sh = ThisWorkbook.Worksheets("202007")
Set sh1 = ThisWorkbook.Worksheets("最低工资标准补发OR扣回列明细")
Set sh2 = ThisWorkbook.Worksheets("工资事项告知")
ar = sh.[a1].CurrentRegion
For i = 2 To UBound(ar)
    If Trim(ar(i, 2)) <> "" Then
        sh.Copy
        Set wb = ActiveWorkbook
        With wb.Worksheets(1)
            For s = 2 To UBound(ar)
                If Trim(.Cells(s, 2)) <> Trim(ar(i, 2)) Then
                    If rng Is Nothing Then
                        Set rng = .Rows(s)
                    Else
                        Set rng = Union(rng, .Rows(s))
                    End If
                End If
            Next s
            rng.Delete
        End With
        ThisWorkbook.Worksheets(Array("最低工资标准补发OR扣回列明细", "工资事项告知")).Copy after:=wb.Worksheets(wb.Worksheets.Count)
        Set rng = Nothing
        wb.SaveAs Filename:=ThisWorkbook.Path & "\" & ar(i, 2)
        wb.Close
    End If
Next i
MsgBox "ok!"
End Sub

3190496160

代码模板中运行代码，结果在同一个路径下

yq1163022574

3190496160 发表于 2020-8-30 08:00
Sub chaifen()
Dim sh As Sheet1, rng As Range
Set sh = ThisWorkbook.Worksheets("202007")

如果按照HR代码来拆呢，怎么改啊，大神

yq1163022574

yq1163022574 发表于 2020-8-30 22:37
如果按照HR代码来拆呢，怎么改啊，大神

会了，谢谢

yq1163022574

3190496160 发表于 2020-8-30 08:00
Sub chaifen()
Dim sh As Sheet1, rng As Range
Set sh = ThisWorkbook.Worksheets("202007")

额，还有个问题，我的条件列中的数据不是唯一的，拆分的时候会提示已经存在相同名字的工作簿了，然后运行就停止了。

3190496160

yq1163022574 发表于 2020-8-30 22:56
额，还有个问题，我的条件列中的数据不是唯一的，拆分的时候会提示已经存在相同名字的工作簿了，然后运行 ...

重新新上传附件