엑셀 지정한 행까지 끊어서 여러파일로 저장하기

Profile
hyogle
재생하기

고도몰5 쇼핑몰 솔루션을 친애하는 나였지만 대량등록이 200개도 넘기기 힘듭니다.  셀내용이 많으면 오류가 더 많이 나지요

이래서 무슨 대량등록이라고 할 수 있겠습니까?

답답한 노릇이죠


5000개의 상품을 대량등록으로 진행하려면 25번 이상의 단순 노가다가 발생됩니다. 시간이 금인데 그들은 우리의 시간을 헛되게 합니다. 그래서 시간을 아껴보고자 검색 들어갔지요


http://blog.naver.com/jsk005/150180850094

[VBA] 지정한 행만큼씩 나눠서 파일로 저장하기 엑셀파일을 다루다 보면 지정한 행만큼씩 파일로 분리하...


자세한 설명과 함께 파일까지 올려두셨습니다. 

파일을 헤집어보면 다음과 같습니다. 


Option Explicit


Sub split_As_per_Rows()

    ' 지정한 행만큼씩 파일을 나눠서 저장하는 VBA

    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

 


    Application.ScreenUpdating = False      '화면 업데이트 (일시)정지

    Set rngAll = ActiveSheet.UsedRange      '사용전체영역을 변수에 넣음

    SplitLine = 5000                        '이 숫자대로 파일이 나누어지므로 이 숫자를 원하는 만큼 변경하여 사용하면 됨

    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


알아보기 힘든 명령어지만 하나하나 뜯어보면 그 의미를 알수 있습니다.

카쎈님들 화이팅!





Profile
hyogle Level. 28 74870/75690

^^

댓글
1
  • hyogle
    작성자
    2020.06.17
    비밀글입니다.

    비밀번호를 입력하세요.

Profile
번호 제목 글쓴이 날짜 조회 수
803 부품 k9 앞패드 581013na50 58101-3na50 sp1547 fphH29 profile hyogle 2020.12.14 209
802 정비 올란도 에어컨필터 교환했어요 profile hyogle 2020.12.14 79
801 기타 이동형 정비테이블 리뷰영상 profile hyogle 2020.12.11 99
800 부품 K7(EPB) 리어 브레이크패드 58302F6A50 58302-F6A50 sp1846 fph35nr profile hyogle 2020.12.08 289
799 기타 엔진오일 교환주기 스티커 만들기 profile hyogle 2020.11.24 1433
798 정비 오줌 지리는 올뉴카니발, 겨우 이거? profile hyogle 2020.11.24 105
797 정비 미칠 것 같은 소음과의 전쟁 BMW E39 1편 profile hyogle 2020.11.24 317
796 기타 브레이크패드 소리난다고 해서 빼보니 경악! profile hyogle 2020.11.23 195
795 정비 시에나 리어 허브베어링 교체영상 profile hyogle 2020.11.22 428
794 k5 11년식 뒤패드 583022TA00 58302-2TA00 sp1239 fph17r profile hyogle 2020.11.20 140
793 부품 LF소나타 앞패드 58101C1A00 58101-C1A00 sp1681 profile hyogle 2020.11.19 176
792 부품 타이어 무시 고무 (1) profile hyogle 2020.11.18 127
791 부품 그랜저HG 2012 앞패드 581012ta20 58101-2ta20 SP1403 FPH28 profile hyogle 2020.11.17 131
790 부품 더뉴k5 에어컨필터 97133g8000 97133-g8000 CF1052 보쉬-p5583 3m-5274 사이즈225-252-30 profile hyogle 2020.11.17 246
789 HG 2.2 디젤 58101-3va90 581013va90 SP1545 k30-k93.3 profile hyogle 2020.11.16 152
788 뉴에쿠스 뒤패드 58302-3na00 583023na00 sp1247 h23r profile hyogle 2020.11.16 86
787 부품 뉴에쿠스 09년 앞패드 58101-3ma10 581013ma10 sp1206 h16 profile hyogle 2020.11.16 221
786 부품 k5 nf ix 앞디스크 순정 51712-3k010 발레오 RB1032 profile hyogle 2020.11.16 125
785 모하비더마스터 싼타페더프라임 더뉴맥스크루즈 앞패드 58101-b8a00 sp4374 h43 profile hyogle 2020.11.13 111
784 봉고3 포터2 보조미러 장착 영상 (1) profile hyogle 2020.11.13 300

로그인

모바일로 접속하세요.
서버에 요청 중입니다. 잠시만 기다려 주십시오...