한 시트 파일을 여러개로 나눠 저장

한 시트 파일을 여러개로 나눠 저장

엑셀을 다루다보면 한 시트의 파일을 여러개로 나눠서 저장할 일이 있습니다.

아래 첨부파일을 다운로드 받아서 복사하여 이용하면 됩니다.

Split_Rows.vbs

Sub split_As_per_Rows()
    '// 지정한 행만큼씩 파일을 나눠서 저장하는 VBA
    Dim Counter
    Dim rngAll As Range                           '//모든 영역을 저장할 변수
    Dim SplitLine As Integer                      '//몇 행씩 나눌지를 정하는 변수
    Dim rowsCount As Long, colsCount As Integer   '//행 및 열의 갯수 저장할 변수
    Dim strPath As String                         '//파일저장 경로를 넣을 변수
    Dim i As Long                                 '//반복구문 숫자 증가에 사용할 변수
    Dim rowsNo As Long                            '//행 증가에 사용할 변수
    Dim rngSplit As Range                         '//나누어진 영역을 저장할 변수
    Dim strName As String
   
    Counter = InputBox("분할할 행의 수 입력하세요")
    If Counter = "" Then Exit Sub           '// 취소 선택시 매크로 중단
    If Not IsNumeric(Counter) Then Exit Sub '// 입력한 값이 숫자가 아닌 경우

    Application.ScreenUpdating = False      '//화면 업데이트 (일시)정지
    Set rngAll = ActiveSheet.UsedRange      '//사용전체영역을 변수에 넣음
    SplitLine = Counter                     '// 입력한 숫자 만큼 파일이 나눠서 저장
    rowsCount = rngAll.Rows.Count           '//전체 행의 숫자를 행 변수에 넣음
    colsCount = rngAll.Columns.Count        '//전체 열의 숫자를 열 변수에 넣음
    strPath = ThisWorkbook.Path & Application.PathSeparator   '//현재 파일이 있는 경로에 저장

    With ThisWorkbook
      strName = Left(.Name, Len(.Name) - 5)  '//Excel 파일의 확장자 제거. 만약 xls 파일이면 숫자를 4로 변경
    End With

    For i = 2 To rowsCount Step SplitLine                                     '//SplitLine 만큼씩 증가하며 반복
        rowsNo = i + SplitLine                                                 '//행도 지정한 SplitLine 만큼씩 증가
        Set rngSplit = Range(Cells(i, 1), Cells(rowsNo + 1, colsCount))         '//나누어진 영역을 변수에 넣음
        Workbooks.Add                                                         '//새로운 workbook을 생성
        rngAll.Rows(1).SpecialCells(2).Copy Cells(1, 1)                         '//첫줄 제목을 각 workbook에 복사
        Range(Cells(2, 1), Cells(SplitLine + 1, colsCount)) = rngSplit.Value

          '//2번째 행부터 나누어진 영역(SplitLine 만큼)을 복사
        Columns.AutoFit  '//열너비 자동맞춤
        ActiveWorkbook.SaveAs strPath & strName & "(" & ((i - 1) \ SplitLine) + 1 & ").xlsx", FileFormat:=xlOpenXMLWorkbook
                     '//현재 파일이 있는 경로에 현재파일명 + SplitLine 만큼씩 나눠서 몫으로 카운트하면서 저장
        ActiveWorkbook.Close   '//새로 만든 workbook을 저장
    Next i

    Set rngAll = Nothing     '//개체변수들 초기화(사용 메모리 비우기)
    Set rngSplit = Nothing
End Sub