OfficeTutor 365

수고하세용^^

Sub Working()
    Dim WS As Worksheet
    Dim R As Range
    Dim sName As String
    Dim sNextName As String
    Dim i As Integer
    Dim iRow As Integer
    
    Set R = Application.InputBox(Prompt:="시작셀 선택하십시오!", Title:="작업시작", Type:=8)
    Application.ScreenUpdating = False
    
    Set WS = Worksheets.Add
    If Not R Is Nothing Then
        
        Do
            sName = R
            sNextName = R.Offset(1, 0)
            
            i = i + 1
            iRow = iRow + 1
            With WS
                 .Cells(1 + iRow, 1) = R
                 .Cells(1 + iRow, 2) = R.Offset(0, 1)
                 .Cells(1 + iRow, 3) = R.Offset(0, 2)
            End With

            If sName <> sNextName And i < 5 Then
               Do
                  iRow = iRow + 1
                  WS.Cells(1 + iRow, 1) = R
                  i = i + 1
               Loop Until i = 5
            End If
            
            If i = 5 Then
                With WS.Range(WS.Cells(1 + iRow, 1), WS.Cells(1 + iRow, 3)).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
                End With
                i = 0
            End If
            Set R = R.Offset(1, 0)

        Loop Until Len(R.Formula) = 0
        
        With WS.Range("A1:C1")
            .Value = Array("Name", "Idnum", "Cost")
            .Interior.ColorIndex = 15
            .Borders(xlEdgeBottom).LineStyle = xlDouble
            .Borders(xlEdgeBottom).Weight = xlThick
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        End With
    End If
    
End Sub