समझिए
1. काम
Data शीट में सारे रीजन की बिक्री है। हर महीने आप North फ़िल्टर करते हैं, कॉपी करते हैं, नई फ़ाइल में पेस्ट करते हैं, North.xlsx नाम से सेव करते हैं… और हर रीजन के लिए यही दोहराते हैं। मैक्रो यह सेकंडों में करता है।
| A | B | C | D | E | |
|---|---|---|---|---|---|
| 1 | Date | Salesperson | Region | Product | Amount |
| 2 | 01-Apr | Amit | North | Laptop | 55000 |
| 3 | 03-Apr | Neha | South | Mobile | 18000 |
| … | … | … | … | … | … |
2. योजना
- स्प्लिट कॉलम (Region) की हर अलग वैल्यू ढूँढो।
- हर वैल्यू के लिए: डेटा फ़िल्टर करो, दिखने वाली रो (हेडर समेत) नई वर्कबुक में कॉपी करो, सेव करो, बंद करो।
- सब कुछ वापस सामान्य करो और बताओ कितनी फ़ाइलें बनीं।
3. कोड
Insert → Module करके यह पेस्ट करें:
Option Explicit
Sub SplitByColumn()
Const SHEET_NAME As String = "Data"
Const KEY_COL As Long = 3 ' column C = Region
Dim ws As Worksheet, wbNew As Workbook
Dim dataRng As Range
Dim lastRow As Long, i As Long
Dim folder As String, fileName As String
Dim keys As Collection, k As Variant
Dim seen As String
On Error GoTo ErrHandler
Set ws = ThisWorkbook.Worksheets(SHEET_NAME)
lastRow = ws.Cells(ws.Rows.Count, KEY_COL).End(xlUp).Row
If lastRow < 2 Then
MsgBox "No data to split.", vbInformation
Exit Sub
End If
Set dataRng = ws.Range("A1").CurrentRegion
' 1) Output folder next to this file
folder = ThisWorkbook.Path & Application.PathSeparator & "Split_" & Format(Date, "yyyy-mm-dd")
If Dir(folder, vbDirectory) = "" Then MkDir folder
' 2) Unique values (Collection works on Windows and Mac)
Set keys = New Collection
seen = "|"
For i = 2 To lastRow
k = Trim(CStr(ws.Cells(i, KEY_COL).Value))
If Len(k) > 0 And InStr(1, seen, "|" & k & "|", vbTextCompare) = 0 Then
keys.Add k
seen = seen & k & "|"
End If
Next i
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' 3) One file per value
For Each k In keys
If ws.AutoFilterMode Then ws.AutoFilterMode = False
dataRng.AutoFilter Field:=KEY_COL, Criteria1:=k
Set wbNew = Workbooks.Add(xlWBATWorksheet)
dataRng.SpecialCells(xlCellTypeVisible).Copy wbNew.Worksheets(1).Range("A1")
With wbNew.Worksheets(1)
.Name = Left(SafeName(CStr(k)), 31)
.Rows(1).Font.Bold = True
.Columns.AutoFit
End With
fileName = folder & Application.PathSeparator & SafeName(CStr(k)) & ".xlsx"
wbNew.SaveAs fileName:=fileName, FileFormat:=xlOpenXMLWorkbook
wbNew.Close SaveChanges:=False
Next k
MsgBox keys.Count & " files saved in:" & vbCrLf & folder, vbInformation
CleanExit:
If ws.AutoFilterMode Then ws.AutoFilterMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "Split failed: " & Err.Description, vbExclamation
Resume CleanExit
End Sub
' Removes characters that are not allowed in file or sheet names
Private Function SafeName(ByVal s As String) As String
Dim ch As Variant
For Each ch In Array("\", "/", ":", "*", "?", """", "<", ">", "|", "[", "]")
s = Replace(s, ch, "-")
Next ch
SafeName = s
End Function
4. यह कैसे काम करता है
- अलग-अलग वैल्यू: एक आसान टेक्स्ट लिस्ट
seenयाद रखती है कि क्या पहले जुड़ चुका है। (कई ट्यूटोरियलScripting.Dictionaryइस्तेमाल करते हैं, जो बहुत बड़ी लिस्ट के लिए तेज़ है पर Mac पर मौजूद नहीं।) - AutoFilter + SpecialCells(xlCellTypeVisible): हेडर और सिर्फ़ मेल खाने वाली रो कॉपी करता है।
- Workbooks.Add(xlWBATWorksheet): ठीक एक शीट वाली नई फ़ाइल।
- FileFormat:=xlOpenXMLWorkbook: सामान्य .xlsx के रूप में सेव (आउटपुट में कोई मैक्रो नहीं)।
- SafeName: "North/East" जैसा रीजन फ़ाइल नाम तोड़ देता; यह "North-East" बन जाता है।
- तारीख़ वाला फ़ोल्डर: हर रन
Split_2026-10-01में जाता है, ताकि पिछले महीने की फ़ाइलें गलती से न बदलें।
5. अपने हिसाब से बदलें
- Salesperson से स्प्लिट:
KEY_COLको 2 करें। - दूसरी शीट:
SHEET_NAMEबदलें। - फ़ाइलों की जगह शीट:
Workbooks.Add … Closeवाले हिस्से कोThisWorkbook.Worksheets.Add(After:=…)से बदलें और वहाँ पेस्ट करें। - सिर्फ़ वैल्यू रखें: कॉपी के बाद
wbNew.Worksheets(1).UsedRange.Value = wbNew.Worksheets(1).UsedRange.Valueजोड़ें।
6. बटन जोड़ें
Developer → Insert → Button (Form Control) → बनाएँ → SplitByColumn असाइन करें। अब कोई भी एक क्लिक में चला सकता है।
आम गलतियाँ
मास्टर फ़ाइल सेव किए बिना चलाना (नई बिना सेव की फ़ाइल का ThisWorkbook.Path खाली होता है)। रीजन कॉलम में खाली सेल। / या : वाले रीजन नाम (SafeName संभालता है)। A1 से शुरू न होने वाला डेटा (CurrentRegion गलत ब्लॉक पकड़ता है)।