특정 조건 자동 입력 (중복되는 내용도 입력되게 하고 싶습니다.)

Option Explicit

'// ===== 상수 선언 =====
Private Const TMPL As String = "신청서"
Private Const PFX As String = "신청서_"

'// 셀 위치 상수
Private Const CEL_NM As String = "E4"
Private Const CEL_JMN As String = "K4"
Private Const CEL_TEL As String = "K5"
Private Const CEL_BUY As String = "A11"
Private Const CEL_APP As String = "A25"
Private Const CEL_SIG As String = "J26"

'// 데이터 영역 상수
Private Const ROW_ST As Long = 11
Private Const ROW_TOT As Long = 19
Private Const COL_ITM As String = "C"
Private Const COL_QTY As String = "F"
Private Const COL_SUP As String = "H"
Private Const COL_TAX As String = "J"
Private Const COL_TOT As String = "L"

Public Sub CreateApp(ByRef Data As AppData)
    Dim ws As Worksheet, coll As Collection
    
    '// 새 시트 생성
    Set ws = MakeWs(Data.nm)
    
    '// 기본 정보 입력
    Call FillBase(ws, Data)
    
    '// 세부 데이터 입력
    Set coll = GetByNm(Data.nm)
    Call FillDtl(ws, coll)
    
    '// 합계 계산
    Call CalcTot(ws, coll.Count)
    
    MsgBox "[" & ws.Name & "] 작성 완료", vbInformation
End Sub
'// 새 신청서 시트 생성
Private Function MakeWs(ByVal nm As String) As Worksheet
    Dim newNm As String, tmplWs As Worksheet
    
    Set tmplWs = GetWs(TMPL)
    If tmplWs Is Nothing Then
        Err.Raise vbObjectError + 1000, , "템플릿 시트를 찾을 수 없습니다."
    End If
    
    newNm = UniqNm(PFX & nm)
    
    '// 템플릿 복사
    tmplWs.Copy After:=Worksheets(Worksheets.Count)
    Set MakeWs = ActiveSheet
    MakeWs.Name = newNm
End Function

'// 기본 정보 입력
Private Sub FillBase(ByVal ws As Worksheet, ByRef Data As AppData)
    With ws
        .Range(CEL_NM).Value = Data.nm
        .Range(CEL_JMN).Value = Data.jmn
        .Range(CEL_TEL).Value = Data.tel
        .Range(CEL_BUY).Value = Format$(Data.buyDt, "yy.mm.dd")
        .Range(CEL_APP).Value = KrFmt(Data.appDt)
        .Range(CEL_SIG).Value = Data.nm
    End With
End Sub

'// 세부 데이터 입력
Private Sub FillDtl(ByVal ws As Worksheet, ByVal coll As Collection)
    Dim row As Long, i As Long, rec As Object
    
    row = ROW_ST
    
    For i = 1 To coll.Count
        Set rec = coll(i)
        
        With ws
            .Range(COL_ITM & row).Value = rec("품목")
            .Range(COL_QTY & row).Value = rec("수량")
            .Range(COL_SUP & row).Value = rec("공급")
            .Range(COL_TAX & row).Value = rec("세액")
            .Range(COL_TOT & row).Value = rec("합계")
        End With
        
        row = row + 1
    Next i
End Sub

'// 합계 계산
Private Sub CalcTot(ByVal ws As Worksheet, ByVal cnt As Long)
    Dim endRow As Long
    
    If cnt = 0 Then Exit Sub
    
    endRow = ROW_ST + cnt - 1
    
    With ws
        .Range(COL_QTY & ROW_TOT).Value = _
            WorksheetFunction.Sum(.Range(COL_QTY & ROW_ST & ":" & COL_QTY & endRow))
        .Range(COL_SUP & ROW_TOT).Value = _
            WorksheetFunction.Sum(.Range(COL_SUP & ROW_ST & ":" & COL_SUP & endRow))
        .Range(COL_TAX & ROW_TOT).Value = _
            WorksheetFunction.Sum(.Range(COL_TAX & ROW_ST & ":" & COL_TAX & endRow))
        .Range(COL_TOT & ROW_TOT).Value = _
            WorksheetFunction.Sum(.Range(COL_TOT & ROW_ST & ":" & COL_TOT & endRow))
    End With
End Sub
'// 워크시트 안전 조회
Private Function GetWs(ByVal nm As String) As Worksheet
    On Error Resume Next
    Set GetWs = Worksheets(nm)
    On Error GoTo 0
End Function

'// 시트 존재 여부 확인
Private Function WsExist(ByVal nm As String) As Boolean
    WsExist = Not GetWs(nm) Is Nothing
End Function

'// 고유한 시트명 생성
Private Function UniqNm(ByVal base As String) As String
    Dim uniq As String, cnt As Long
    
    uniq = base
    cnt = 2
    
    Do While WsExist(uniq)
        uniq = base & "_" & cnt
        cnt = cnt + 1
    Loop
    
    UniqNm = uniq
End Function