Follow these steps
1. Press ALt+F11
2. Insert Menu m ja kar Module Select Karain.
3. Below Code new open hone wale window m paste karain.
4. ALT+Q se vba editor k window close karain
5. Excel k interface m tool k menu m ja kar macro run karain.
6. Macro Aap ko prompt kara ga k apna column select karain . Apna column select karain suppose aap ka data column a m ha ( I assume ka aap ka row 1 coumns ki header row ha jo k automatic tamam sheet m copy ho jae gi.)
NOTE: Before testing this Macro please make a copy of your file.
Code:
Sub Test()
Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, r As Range, iCol As Integer, t As Date
On Error Resume Next
Set r = Application.InputBox("Click in the column to extract by", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Cells(2, iCol), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To lastrow
If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.Name = .Cells(iStart, iCol).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Completed in " & Format(Now - t, "hh:mm:ss.00"), vbInformation
End Sub
If u have some problem please reply. And also intrested k kia aap ka masla hal ho gaya k nahee. If isn't please attach your sheet or screen shot dain
Bookmarks