다시 요청드립니다 SOS 표 자동 확장 VBA

Option Explicit
Sub loadCustomTabOfRibbon(ribbon As IRibbonUI)
 
    '//엑셀이 시작되면 사용자정의 탭을 활성화시킨다.
    On Error Resume Next
    ribbon.ActivateTab "myTabId001"
 
End Sub
Public Sub FrmOpen(control As IRibbonControl)
    frm증빙입력.Show
    
End Sub
Public Function MkDict(Optional ByVal ws As Worksheet) As Object
    '// 세목(A) → 금액이상여부(D) (중복 제거)
    Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
    Dim sd As Object
    Dim r As Long, er As Long
    Dim k As String, a As String, c As String
    
    If ws Is Nothing Then Set ws = ActiveSheet
    er = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
    k = ""
    
    For r = 2 To er
        a = Trim$(CStr(ws.Cells(r, "A").Value))
        c = Trim$(CStr(ws.Cells(r, "D").Value))
        
        If Len(a) > 0 Then
            k = a
            If Not d.Exists(k) Then
                Set sd = CreateObject("Scripting.Dictionary")
                d.Add k, sd
            End If
        End If
        
        If Len(c) > 0 And Len(k) > 0 Then
            Set sd = d(k)
            If Not sd.Exists(c) Then sd.Add c, vbNullString
        End If
    Next r
    
    Set MkDict = d
End Function
Public Sub InsBlk(ByVal ws As Worksheet, _
                  ByVal cel As Range, _
                  ByVal dt As Date, _
                  ByVal sd As Object)
    '// cel 바로 아래에 날짜 1번, 항목수만큼 행 삽입, D열에 항목 채움
    Dim cm As XlCalculation
    cm = Application.Calculation
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    On Error GoTo EH
    
    Dim r0 As Long: r0 = cel.Row
    Dim n As Long: n = sd.Count
    Dim ri As Long: ri = r0 + 1
    
    ws.Rows(ri & ":" & ri + n - 1).Insert Shift:=xlShiftDown
    
    ws.Cells(ri, "B").Value = Format(dt, "yyyy.mm.dd")
    
    Dim i As Long, k As Variant, r As Long: r = ri
    For Each k In sd.Keys
        ws.Cells(r, "D").Value = CStr(k)
        r = r + 1
    Next k
    
    With ws.Range(ws.Cells(ri, "B"), ws.Cells(ri + n - 1, "D"))
        .Font.Size = 10
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
    End With
    
Tidy:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = cm
    Exit Sub
EH:
    Debug.Print "[에러]"; Err.Number, Err.Description
    Resume Tidy
End Sub