Solved: Excel file splitter

[khaledocom]

Hi,

I need your help with regarding the attached file:

I need another file contains a macro that do the following in Subjectfile.xls or any other file:

1-Renames sheets in subject file by the value in cell "B2" in each worksheet.
2-Saves each sheet in a separate workbook with same extension "xls" in the same path of Subject file.

Appreciate your soonest help with this regarding.

Have a nice evening.

[patel]

Sub renameSheets()
Dim fpath As String, fname As String, sh As Worksheet, newname As String
fpath = ThisWorkbook.Path
For Each sh In Sheets
newname = sh.Range("B2").Text
sh.Name = newname
fname = fpath & "\" & newname & ".xls"
sh.Copy
ActiveWorkbook.SaveAs Filename:=fname, CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=False
Next
End Sub

[khaledocom]

Thanks a lot Patel,

But I need to put your great code in another workbook I named it "splitter.xls"
Not in "subjectfile.xls"

Splitter.xls will do the work in subjectfile.xls.

Is it possible Sir?

Thankful again for your soon response.

[khaledocom]

Dear Friends,

Thankful for Mr. Patel for his valuable help, I could solve it at last by the following code:

Sub RenameSplit()
On Error Resume Next

Dim khaledo As Workbook


Set khaledo = Workbooks.Open(Range("A1").Text)


With khaledo
Dim Msg As String, i As Integer
For i = 2 To Sheets.Count
If Sheets(i).Range("b2").Value = "" Then
Msg = "Sheet " & i & "(" & Sheets(i).Name & ") has no value in A1. Fix sheet, then rerun."
MsgBox Msg, vbExclamation
Exit Sub
Else

Sheets(i).Name = Sheets(i).Range("b2").Value
On Error GoTo 0
End If
Next i

Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path
With Application
.ScreenUpdating = False
.DisplayAlerts = False

For N = 2 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With

.SaveAs Filename:=MyFilePath _
& "\" & SheetName & ".xls"
.Close savechanges:=True
End With
.CutCopyMode = False
Next
End With
End With

khaledo.Close savechanges:=False

End Sub