see if it helps change
pathbk = "C:\Documents and Settings\achamanlalko\Desktop\eforms\eform reports\test workbook\" to the destination folder Sub createworkbooks() Dim i As Long Dim a As Workbook Dim z As String Dim pathbk As String pathbk = "C:\Documents and Settings\achamanlalko\Desktop\eforms\eform reports\test workbook\" For i = 1 To ThisWorkbook.Worksheets.Count z = ThisWorkbook.Worksheets(i).Name ThisWorkbook.Worksheets(i).Select ThisWorkbook.Worksheets(i).UsedRange.Copy Set a = Workbooks.Add a.Sheets(1).Activate ActiveSheet.Paste a.SaveAs pathbk & z & Application.WorksheetFunction.Text(Now(), "hhmm") & ".xls" a.Close ThisWorkbook.Activate Next i End Sub On Sun, Apr 10, 2011 at 3:44 PM, C.G.Kumar <kumar.bemlmum...@gmail.com>wrote: > Hi, > > > I want a macro to copy each worksheet in a Workbook in specific folder Say > "H:\31.03.2011_10.04.2011" with File name as name of the active worksheet & > time of generation. For Example: My Workbook contains 35 sheets named > (Brazil,India,US etc) and i ran the macro at say 04:00 then it should Save > 35 worksheets should be saved in specific folder > i.e. "H:\31.03.2011_10.04.2011" named as Brazil 0400 Hrs,India 0400 Hrs & > So on. > > I surfed the internet and found the following code but i am not able to > manipulate to suit my requirement(furnished below). Hope the member of this > group could help me out. > > ----------------------------------------------------------------------------------------------------------------------------------------------------------- > Sub MakeMultipleXLSfromWB() > 'Split worksheets in current workbook into > ' many separate workbooks D.McRitchie, 2004-06-12 > 'Close each module AND the VBE before running to save time > ' provides a means of seeing how big sheets really are > 'Hyperlinks and formulas pointing to other worksheets within > ' the original workbook will usually be unuseable in the new workbooks. > Dim CurWkbook As Workbook > Dim wkSheet As Worksheet > Dim newWkbook As Workbook > Dim wkSheetName As String > Dim shtcnt(3) As Long > Dim xpathname As String, dtimestamp As String > dtimestamp = Format(Now, "yyyymmdd_hhmmss") > xpathname = "H:\31.03.2011_10.04.2011" & dtimestamp & "\" > MkDir xpathname > Set CurWkbook = Application.ActiveWorkbook > > shtcnt(2) = ActiveWorkbook.Sheets.Count > Application.ScreenUpdating = False > Application.Calculation = xlCalculationManual > For Each wkSheet In CurWkbook.Worksheets > shtcnt(1) = shtcnt(1) + 1 > Application.StatusBar = shtcnt(1) & "/" & shtcnt(2) & _ > " " & wkSheet.Name > wkSheetName = Trim(wkSheet.Name) > If wkSheetName = > Left(Application.ActiveWorkbook.Name<http://application.activeworkbook.name/>, > _ > > Len(Application.ActiveWorkbook.Name<http://application.activeworkbook.name/>) > - 4) Then _ > wkSheetName = wkSheetName & "_D" & dtimestamp > Workbooks.Add > ActiveWorkbook.SaveAs _ > Filename:=xpathname & wkSheetName & ".xls", _ > FileFormat:=xlNormal, Password:="", _ > WriteResPassword:="", CreateBackup:=False, _ > ReadOnlyRecommended:=False > Set newWkbook = ActiveWorkbook > > Application.DisplayAlerts = False > newWkbook.Worksheets("sheet1").Delete > On Error Resume Next > newWkbook.Worksheets(wkSheet.Name).Delete > On Error GoTo 0 > Application.DisplayAlerts = True > > CurWkbook.Worksheets(wkSheet.Name).Copy Before:=newWkbook.Sheets(1) > 'no duplicate sheet1 because they begin with "a" > ActiveWorkbook.Save > ActiveWorkbook.Close > Next wkSheet > Application.StatusBar = False 'return control to Excel > Application.Calculation = xlCalculationAutomatic > Application.ScreenUpdating = True > End Sub > > ----------------------------------------------------------- > > Regards, > > C.G.Kumar > > -- > > ---------------------------------------------------------------------------------- > Some important links for excel users: > 1. Follow us on TWITTER for tips tricks and links : > http://twitter.com/exceldailytip > 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 > 3. Excel tutorials at http://www.excel-macros.blogspot.com > 4. Learn VBA Macros at http://www.quickvba.blogspot.com > 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com > > To post to this group, send email to excel-macros@googlegroups.com > > <><><><><><><><><><><><><><><><><><><><><><> > Like our page on facebook , Just follow below link > http://www.facebook.com/discussexcel > -- *Regards* * * *Ashish Koul* *akoul*.*blogspot*.com <http://akoul.blogspot.com/> *akoul*.wordpress.com <http://akoul.wordpress.com/> My Linkedin Profile <http://in.linkedin.com/pub/ashish-koul/10/400/830> P Before printing, think about the environment. -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 3. Excel tutorials at http://www.excel-macros.blogspot.com 4. Learn VBA Macros at http://www.quickvba.blogspot.com 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com <><><><><><><><><><><><><><><><><><><><><><> Like our page on facebook , Just follow below link http://www.facebook.com/discussexcel
