| |
원본데이터 시트하나만 남기고
적용해 보세요.
Option Explicit
Sub 매입처별_분리()
Const AFno% = 3
Dim RC As Long, TRng As Range, TSht As Variant
Dim RR As Long, DRng As Range, vR As Variant
Dim i As Long, COSD As Object
Set COSD = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Worksheets("원본데이터").Range("A1").CurrentRegion
If .Parent.AutoFilterMode Then .AutoFilter
Set TRng = .Cells
vR = TRng.Columns(AFno).Value
RC = Rows.Count
For i = 2 To UBound(vR, 1)
TSht = vR(i, 1)
If Not COSD.Exists(TSht) Then
COSD.Add TSht, Nothing
.AutoFilter AFno, TSht, , , False
If IsError(Evaluate(TSht & "!A1")) Then
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = TSht
End If
With Sheets(TSht)
.Select
.UsedRange.Clear
TRng.Copy: .Range("A1").PasteSpecial (xlPasteColumnWidths)
TRng.Copy .Range("A1")
.Range("A1").Select
End With
End If
Next i
.Parent.Activate
If .Parent.AutoFilterMode Then .AutoFilter
End With
Application.ScreenUpdating = True
MsgBox " 작업완료...!", 32, " ♣ 매입처별 분리 ♣"
End Sub |
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
