Hi All,
I am trying to split the attached sheet into different files currency wise (reference column K). For e.g. for all USD Deals the sheet should form a seperate file as USD.xlsx
The data could go on till row 40000 also.
Also it should save in folder named Trade.
if some one could guide me that would be really handy.
Anyone 
Re: Macro for splitting sheet
i just wrote it a few days back see if this helps...
Dim rw As Long, rw1 As Long
Application.ScreenUpdating = False
Sheets.Add after:=Sheets(1): ActiveSheet.Name = "Criteria"
Worksheets("Index Sheet").AutoFilterMode = False
Worksheets("Index Sheet").range("D6:D65536").Copy
range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
range("A2").Select
Do While ActiveCell.Value <> ""
arra = arra & "%" & ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
arra = Split(arra, "%")
Application.DisplayAlerts = False
Sheets("Criteria").Delete
Application.DisplayAlerts = True
For m = 1 To UBound(arra)
rw = Worksheets("Index Sheet").range("A:B").Find(what:="Entity", MatchCase:=True).Offset(1, 0).Row
Worksheets("Index sheet").AutoFilterMode = False
rw1 = Worksheets("Index Sheet").range(Left(Worksheets("Index Sheet").range("A:B").Find(what:="Entity", MatchCase:=True).Address(1, 0), InStr(Worksheets("Index Sheet").range("A:B").Find(what:="Entity", MatchCase:=True).Address(1, 0), "$") - 1) & 65536).End(xlUp).Offset(1, 0).Row
sh_coll = ""
Worksheets("Index sheet").range(rw - 1 & ":" & rw - 1).AutoFilter field:=4, Criteria1:=arra(m)
Do While rw <> rw1
If Worksheets("Index Sheet").range("A" & rw).Rows.Hidden = False Then
sh_coll = sh_coll & "%" & Worksheets("Index Sheet").range("A" & rw).Value
End If
rw = rw + 1
Loop
sh_coll = Split(sh_coll, "%")
If UBound(sh_coll) < 0 Then GoTo EN:
Set wbk = Workbooks.Add
wbk.SaveAs ThisWorkbook.Path & "\" & arra(m) & ".xlsx", FileFormat:=51
For l = 1 To UBound(sh_coll)
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(sh_coll(l)).Copy after:=wbk.Worksheets(l)
range("B12").Copy
range("B12").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Next l
Application.DisplayAlerts = False
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
Sheets(1).Select
wbk.Close True
EN:
Next m
Worksheets("Index sheet").AutoFilterMode = False
MsgBox "Process Complete" & vbNewLine & "File Saved In " & ThisWorkbook.Path, vbInformation, "Admin"
Application.ScreenUpdating = True
End SubRe: Macro for splitting sheet
Hi Ashu,
Thanks for your reply. But after opening a new module and pasting above Macro, i am not able to view macro and run it after pressing ALt + F8
I am really novice on VBAs, guidance please
Re: Macro for splitting sheet
Inski,
Have you ensured that you have a Sub statement at the start of the routine?
Paste this into the top of the code that has been listed above:
Sub Transfer_USD()From looking at the code above, it is not very relevant to what you are trying to do. I think it's just something for you to borrow from.
Don’t have an account yet? Register yourself now and be a part of our community!