| |
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:=xlPasteValues '// 값 복사
End With
Range("E1").Select
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
=======================================================================
엑셀 분할 매크로 소스 입니다
이 매크로로는 전체 시트 첫번째 줄 복사 + 분할 행 입력값으로 파일을 나눠주는데.. 전체 시트 첫번째 ~ 3번째 줄 복사 + 분할 행 입력값으로 수정을 하고 싶습니다.ㅠㅠ
rngAll.Rows(1).SpecialCells(2).Copy Cells(1, 1) '//첫줄 제목을 각 workbook에 복사
rngSplit.Copy '//2번째 행부터 SplitLine 만큼 나누어진 영역을 복사
With Cells(2, 1)
.PasteSpecial P
이쪽 코드를 손보면 될 것 같은데, 저로썬 무리네요 ㅠㅠ 도움 부탁드립니다. |
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
