🔹 엑셀 꿀팁! “동일값별 시트 자동 생성 + 셀 자동 맞춤” 기능 추가하기
엑셀로 데이터를 관리하다 보면, 특정 열의 값별로 시트를 나누어 정리하고 싶을 때가 많습니다.
예를 들어 ‘부서별’, ‘제품별’, ‘고객별’ 데이터를 자동으로 나누어 새로운 시트에 정리하고 싶을 때, 하나씩 복사하다 보면 시간도 오래 걸리고 실수도 생기죠.
이런 고민을 해결해주는 엑셀 VBA 매크로를 만들었습니다.
🔹 기능 소개
기준 열 선택 가능
키보드 입력(A, B, C…)으로 열 지정 가능
마우스로 열 선택도 가능
→ 편한 방법으로 열을 선택하면 됩니다.
동일값별 시트 자동 생성
선택한 열의 고유값을 기준으로 새로운 시트 생성
예: ‘사과’, ‘바나나’, ‘배’가 있으면 각각의 시트가 자동 생성
데이터 자동 복사
각 시트에 해당 값만 자동으로 복사
헤더 행도 그대로 복사
셀 크기 자동 맞춤
열 너비, 행 높이를 자동 조정
바로 보기 좋게 정리 완료
🔹 사용법
엑셀에서 매크로 실행
기준이 될 열을 키보드로 입력(A/B/C)하거나 마우스로 선택
확인 메시지 후 자동으로 시트 생성 및 정리 완료
✅ 단 몇 초 만에 데이터 정리가 끝납니다.
🔹 VBA 코드 핵심
' 키보드 입력(A/B/C) 또는 마우스로 선택 가능
inputStr = InputBox("기준이 될 열을 입력하세요 (A, B, C…) 또는 마우스로 선택하세요", "기준 열 선택")
If inputStr <> "" Then
keyCol = Columns(UCase(inputStr)).Column
Else
Set keyRange = Application.InputBox("기준이 될 열을 마우스로 선택하세요", "기준 열 선택", Type:=8)
keyCol = keyRange.Columns(1).Column
End If
' 고유값 수집 및 시트 생성
For Each key In dict.Keys
' 시트 생성 및 데이터 복사
Next key
' 셀 자동 맞춤
tgtWs.Columns.AutoFit
tgtWs.Rows.AutoFit
Option Explicit
' 리본 버튼용' 리본 버튼용
Public Sub btn동일자료시트생성(control As IRibbonControl)
Call 기준열_Input_동일값별_시트생성_셀자동
End Sub
Public Sub 기준열_Input_동일값별_시트생성_셀자동()
Dim srcWs As Worksheet
Dim keyCol As Long
Dim lastRow As Long, lastCol As Long
Dim dict As Object
Dim r As Long, key As Variant
Dim tgtWs As Worksheet
Dim pasteRow As Long
Dim keyRange As Range
Dim inputStr As String
Set srcWs = ActiveSheet
' 1?? 키보드 입력(A, B, C…) 또는 마우스 선택
inputStr = InputBox("기준이 될 열을 입력하세요 (A, B, C…) 또는 마우스로 선택하세요", "기준 열 선택")
If inputStr <> "" Then
' 문자 입력 시 열 번호로 변환
keyCol = Columns(UCase(inputStr)).Column
Else
' 마우스로 선택
On Error Resume Next
Set keyRange = Application.InputBox("기준이 될 열을 마우스로 선택하세요", "기준 열 선택", Type:=8)
On Error GoTo 0
If keyRange Is Nothing Then
MsgBox "기준 열이 선택되지 않았습니다.", vbExclamation
Exit Sub
End If
keyCol = keyRange.Columns(1).Column
End If
' 마지막 행/열 계산
lastRow = srcWs.Cells(srcWs.Rows.Count, keyCol).End(xlUp).Row
lastCol = srcWs.Cells(1, srcWs.Columns.Count).End(xlToLeft).Column
Set dict = CreateObject("Scripting.Dictionary")
' 고유값 수집
For r = 2 To lastRow
If Trim(srcWs.Cells(r, keyCol).Value) <> "" Then
dict(srcWs.Cells(r, keyCol).Value) = 1
End If
Next r
Application.ScreenUpdating = False
' 값별 시트 생성
For Each key In dict.Keys
Set tgtWs = Nothing
Dim sheetName As String
sheetName = Left(CStr(key), 31)
On Error Resume Next
Set tgtWs = Worksheets(sheetName)
On Error GoTo 0
If tgtWs Is Nothing Then
Set tgtWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))
tgtWs.Name = sheetName
Else
tgtWs.Cells.Clear
End If
' 헤더 복사
srcWs.Rows(1).Copy tgtWs.Rows(1)
pasteRow = 2
' 데이터 복사
For r = 2 To lastRow
If srcWs.Cells(r, keyCol).Value = key Then
srcWs.Range(srcWs.Cells(r, 1), srcWs.Cells(r, lastCol)).Copy _
tgtWs.Cells(pasteRow, 1)
pasteRow = pasteRow + 1
End If
Next r
' 셀 크기 자동 맞춤
tgtWs.Columns.AutoFit
tgtWs.Rows.AutoFit
Next key
Application.ScreenUpdating = True
MsgBox "시트 생성 + 셀 크기 자동 완료!", vbInformation
End Sub
🔹 장점
반복적인 복사/붙여넣기 작업 제거
데이터 정리가 빠르고 깔끔하게 완료
엑셀 작업 시간을 대폭 단축
누구나 쉽게 사용할 수 있는 직관적 UI
💡 Tip
홈 탭에 버튼을 추가하면 클릭 한 번으로 실행 가능!
보고서를 만들거나 정기 데이터 관리할 때 정말 유용합니다.