Sir,
Thanks for the codes. But it lacks two things; 1. Objective is to create Worksheet with Value,Format & JPEG image attached in the source worksheet but the Macro copies the worksheet along with formula and excludes JPEG image . 2. If possible is it possible to ask from user to specify which worksheet he intend to copy. Thanks & Regards, C.G.Kumar On Mon, Apr 11, 2011 at 6:22 AM, ashish koul <koul.ash...@gmail.com> wrote: > 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 > -- ---------------------------------------------------------------------------------- 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
