[VBA] 현 시트내용을 서식 포함 여러개 파일로 분할 저장

현 시트내용을 서식 포함 여러개 파일로 분할 저장

열너비 및 서식까지 그대로 복사하면서 파일을 분할하여 내보내기하는 VBA 코드

Sub split_As_per_Rows()
    '// 지정한 행만큼씩 파일을 나눠서 저장하는 VBA
    Dim Counter As String
    Dim rngAll As Range                           '//모든 영역을 저장할 변수
    Dim SplitLine As Integer                      '//몇 행씩 나눌지를 정하는 변수
    Dim rowsCount As Long, colsCount As Integer   '//행 및 열의 갯수 저장할 변수
    Dim strPath As String                         '//파일저장 경로를 넣을 변수
    Dim i 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 = 1 To rowsCount Step SplitLine          '//SplitLine 만큼씩 증가하며 반복
        Set rngSplit = Range(Cells(i + 1, 1), Cells(i + SplitLine, colsCount))   '//나누어진 영역을 변수에 넣음
        Workbooks.Add                                 '//새로운 workbook을 생성
        rngAll.Rows(1).SpecialCells(2).Copy Cells(1, 1)      '//첫줄 제목을 각 workbook에 복사           
        rngSplit.Copy      '//2번째 행부터 SplitLine 만큼 나누어진 영역을 복사        
        With Cells(2, 1)
            .PasteSpecial Paste:=xlPasteColumnWidths  '//열너비 복사
            .PasteSpecial Paste:=xlPasteFormats       '//양식 복사
            .PasteSpecial Paste:=xlPasteValues       '// 값 복사
        End With
       
        Range("E1").Select
        Selection.AutoFilter    '// 첫줄 자동필터 지정
               
        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