VB(A)

지역별로 시트 생성하여 나누기

당근쨈 2017. 5. 16. 19:14

http://cafe.naver.com/excelmaster/139020


J열에 지사가 나열되어 있음

지사별로 시트를 생성하여 나누는 매크로


1. J열에서 지사의 고유값을 추출

2. 지사명을 순환하며 시트명을 생성

3. 지사별로 데이터를 각 시트에 뿌리기


그 옛날, 구급계 업무를 볼 때 정말 필요했던 기능인데, 지금은 쓸 일이 없다는 점이 함정


Sub Macro()
 
    Dim C As New Collection
    Dim SingleRange As Range
    Dim JArea As Range
    Dim i As Integer
    Dim AllDB As Worksheet
    
    Set AllDB = Sheets("전체DB")
    Set JArea = Range("J2", Cells(Rows.Count, "J").End(3))
    
    'J열(지사) 고유값 추출
    On Error Resume Next
    
    For Each SingleRange In JArea
        C.Add SingleRange, CStr(SingleRange)
    Next SingleRange
    
    On Error GoTo 0
    
    '추출한 지사명으로 자동필터 실행.
    '지사명으로 시트 생성하여 복 붙
    For i = 1 To C.Count
    
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = C.Item(i) & "DB"
        
        With AllDB.Range("A1").CurrentRegion
            .AutoFilter Field:=10, Criteria1:=C.Item(i)
            .Copy Sheets(Sheets.Count).Range("A1")
        End With
        
    Next i
    
    With AllDB
        .Range("A1").CurrentRegion.AutoFilter
        .Activate
    End With
    
End Sub
 
cs


리스트자동추출하는방법.xlsm