VBA 행 수를 기준으로 파일 분할

• 더미 데이터 생성 사이트 - https://www.mockaroo.com/

한 엑셀 파일에 20명이 존재한다. 인원이 많아 각각 3명씩 나눠서 엑셀 파일로 저장하고 싶을 때
아래 메크로를 활용한다.

 Option Explicit
 
 Sub Macro()
 Dim i As Long, iR As Long
 Dim cN As Integer, n As Integer, k As Integer, iC As Integer
 Dim sFname As String, sT As String
 Dim sPath As String
 Dim vD As Variant
 Dim nWb As Workbook
 With Application
    .ScreenUpdating = 0
    .DisplayAlerts = 0
    On Error Resume Next
       cN = Application.InputBox("몇명씩 분할 할 것인지 인원수를 입력하세요", "분할인원입력", Type:=2)
       If Err Then Err.Clear
    On Error GoTo 0
    If cN = 0 Then Exit Sub
    With ThisWorkbook
       sPath = .Path
       sT = Replace(.Name, ".xlsm", "")
 
       With .Sheets("대상자목록")
          iR = .Cells(Rows.Count, 1).End(3).Row
          iC = .Cells(1, Columns.Count).End(1).Column
          For i = 1 To (iR / cN)
             k = Application.CountA(.Cells(1, 1).Offset((i - 1) * cN + 1).Resize(cN))
             sFname = sT & i & Format(k, "(#명)") & ".xlsx"
             .Copy
             With ActiveWorkbook
                With ActiveSheet
                   .Buttons.Delete
                   vD = .Cells(1, 1).Offset((i - 1) * cN + 1).Resize(cN, iC).Value
                   .Cells(1, 1).CurrentRegion.Offset(1).ClearContents
                   .Cells(2, 1).Resize(cN, iC).Value = vD
                End With
                .SaveAs sPath & "\" & sFname
                .Close
             End With
             Application.CutCopyMode = False
          Next
       End With
    End With
 
    .DisplayAlerts = 1
    .ScreenUpdating = 1
    k = iR / cN
    MsgBox k & "개의 파일을 생성했습니다", , "완료!!"
 End With
 End Sub

엑셀에서 Alt + F8을 눌러 메크로 실행 혹은 단추1을 클릭한다.
분할할 인원을 입력하고 확인 요청하면 각 인원 별로 엑셀 파일이 저장된다.

sample.xlsm

0.02MB