vba 로 하루종일 챗gpt로 싸워도 답을 못찾겠네요

Sub CheckDup()
 
    Dim sh As Worksheet, vData As Variant, oDict As Object, iR As Long, vKey As Variant
    Set oDict = CreateObject("Scripting.Dictionary")
    For Each sh In Worksheets
        vData = sh.UsedRange.Value2
        For iR = 2 To UBound(vData, 1)
            If vData(1, 2) <> "성명" Then Exit For
            If Not IsEmpty(vData(iR, 2)) Then
                vKey = vData(iR, 2)
                If TypeName(vKey) = "String" And IsNumeric(vKey) Then vKey = "'" & vKey Else vKey = CStr(vKey)
                If Not oDict.Exists(vKey) Then
                    oDict(vKey) = sh.Name
                Else
                    oDict(vKey) = oDict(vKey) & "," & sh.Name
                End If
            End If
        Next iR
    Next sh
 
    For Each vKey In oDict.keys()
        If InStr(oDict(vKey), ",") = 0 Then oDict.Remove vKey
    Next
 
    If oDict.Count = 0 Then MsgBox "중복된 이름이 없습니다.": Exit Sub
    Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    sh.Range("A1:B1") = Array("이름", "시트")
    sh.Range("A2").Resize(oDict.Count, 1) = Application.Transpose(oDict.keys())
    sh.Range("B2").Resize(oDict.Count, 1) = Application.Transpose(oDict.Items())
 
End Sub