View Full Version : Solved: Excel file splitter
khaledocom
06-07-2013, 11:06 AM
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
06-07-2013, 11:30 AM
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
06-07-2013, 11:54 AM
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
06-07-2013, 02:02 PM
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.