Public Function getCount(sName As String)

    getCount = Worksheets(sName).Range("A" & rows.count).End(xlUp).Row
    
End Function

Public Function getIds(sName As String) 'As Array

    Application.Volatile True
    
    Dim dic As Object, n As Integer, count As Integer, id As String
    
    Set dic = CreateObject("Scripting.Dictionary")
    
    count = getCount(sName)
    
    For n = 2 To count
    
        id = Worksheets(sName).Range("A" & n).Value
        
        If Not dic.exists(id) Then
        
            dic.Add id, ""
            
        End If
        
    Next n
    
getIds = dic.Keys

End Function

Public Function setSheets(arr)

    Application.Volatile True
    
    Dim s As Boolean, i As Integer, n As Integer
    
    s = False
    
    For i = 0 To UBound(arr)

        For n = 1 To ThisWorkbook.Worksheets.count
        
            If Sheets(n).Name = arr(i) Then
            
                s = True
                
                Exit For
                
            End If
            
        Next n
        
        If s Then
        
        Application.DisplayAlerts = False '删除不提示
        
        Sheets(arr(i)).Delete
        
        Application.DisplayAlerts = True
        
        End If
        
    Worksheets("审批模板").Copy after:=Sheets(Sheets.count)
    
    Worksheets(Sheets.count).Name = arr(i)
    
    Worksheets(arr(i)).Range("F2").Value = arr(i)
    
    Next i
    
End Function

Public Function dealData(sName As String)
    
    Dim r As Integer
    
    r = getCount(sName)
    
    ids = getIds(sName)
    
    Call setSheets(ids)
    
    For n = 2 To r
    
        For i = 0 To UBound(ids)
            
            If Worksheets(sName).Range("A" & n) = ids(i) Then
                
                Worksheets(sName).Range("B" & n).Resize(1, 7).Copy
                
                Worksheets(ids(i)).Range("A4").Insert shift:=xlDown
                
            End If
                        
        Next i
        
    Next n

End Function


Public Sub 计算()

Application.ScreenUpdating = False

Call dealData("事业")
    
Application.ScreenUpdating = True
    
End Sub