엑셀에서 VBA를 활용해 조건별로 데이터를 필터링하고 자동으로 파일로 저장하는 방법

Sub FilterAndExport()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim folderPath As String
Dim region As String

Set ws = ThisWorkbook.Sheets("Sheet1")
Set rng = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)

' 저장할 폴더 경로 설정
folderPath = ThisWorkbook.Path & "\FilteredFiles\"
If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath

' 중복 제거된 지역 목록 만들기
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

For Each cell In rng
region = Trim(cell.Value)
If Not dict.exists(region) And region < "" Then
dict.Add region, Nothing
End If
Next cell

' 각 지역별로 필터링하고 저장
Dim regionKey As Variant
For Each regionKey In dict.Keys
ws.Range("A1").AutoFilter Field:=1, Criteria1:=regionKey

' 필터된 데이터 복사
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy

' 새 워크북에 붙여넣기
Dim newWb As Workbook
Set newWb = Workbooks.Add
newWb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues

' 파일 저장
newWb.SaveAs folderPath & regionKey & ".xlsx"
newWb.Close SaveChanges:=False
Next regionKey

' 필터 해제
ws.AutoFilterMode = False

MsgBox "완료되었습니다!"
End Sub