누구도 평범한 사람은 없다

[매크로] 2000건씩 잘라서 시트에 나눠담기 본문

엑셀

[매크로] 2000건씩 잘라서 시트에 나눠담기

Hue Kim 2012. 6. 15. 13:07

Sub split10000()
'
' split10000 Macro
' 10000건 시트별로 나눠담기
'
' 바로 가기 키: Ctrl+e
'
    Range("A1:A2000").Select
    Selection.Copy
    Sheets("Sheet1").Select
    ActiveSheet.Paste
    Sheets("dataSheet").Select
    Application.Goto Reference:="R2001C1"
    Range("A2001:A4000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    ActiveSheet.Paste
    Sheets("dataSheet").Select
    Application.Goto Reference:="R4001C1"
    Range("A4001:A6000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    ActiveSheet.Paste
    Sheets("dataSheet").Select
    Application.Goto Reference:="R6001C1"
    Range("A6001:A8000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    ActiveSheet.Paste
    Sheets("dataSheet").Select
    Application.Goto Reference:="R8001C1"
    Range("A8001:A10000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet5").Select
    ActiveSheet.Paste
    
    Dim strPath As String                   '저장할 폴더의 경로를 넣을 변수
    
    
    With Application.FileDialog(msoFileDialogFolderPicker)  '폴더선택 창에서
        .Show                                             '폴더 선택창 띄우기
 
        If .SelectedItems.Count = 0 Then         '취소 선택 시
            Exit Sub                                       '매크로 중단
        Else
            strPath = .SelectedItems(1) & "\"   '폴더 경로를 변수에 넣음
        End If
    End With
    
       
    Application.CutCopyMode = False
    Sheets("sheet1").Select
    ActiveWorkbook.SaveAs strPath & "sheet1.csv", FileFormat:=xlCSV _
        , CreateBackup:=False
    Sheets("sheet2").Select
    ActiveWorkbook.SaveAs strPath & "sheet2.csv", FileFormat:=xlCSV _
        , CreateBackup:=False
    Sheets("sheet3").Select
    ActiveWorkbook.SaveAs strPath & "sheet3.csv", FileFormat:=xlCSV _
        , CreateBackup:=False
    Sheets("sheet4").Select
    ActiveWorkbook.SaveAs strPath & "sheet4.csv", FileFormat:=xlCSV _
        , CreateBackup:=False
    Sheets("sheet5").Select
    ActiveWorkbook.SaveAs strPath & "sheet5.csv", FileFormat:=xlCSV _
        , CreateBackup:=False
        
    MsgBox "파일 저장이 완료되었습니다."

End Sub

Comments