Home |
Search |
Today's Posts |
#1
![]() |
|||
|
|||
![]()
Hi All Excel Gurus
I need a little help, I got following code from a website.I modified this to my use and is working exactly fine except a very little problem. this macro creates new workbooks for me. Can someone help me how can i rename the worksheet in the new generated workbook as "Data" by default. Any help is highly appreciated: Sub sheetsaver() 'Working in 97-2013 Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim sh As Worksheet Dim DateString As String Dim FolderName As String With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With 'Copy every sheet from the workbook with this macro Set Sourcewb = ActiveWorkbook 'Create new folder to save the new files in DateString = Format(Now, "dd-mm-yyyy hhmmss") 'FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString FolderName = Sourcewb.Path & "\" & "Reconlite Input Files" & " " & DateString Set FSO = CreateObject("Scripting.FileSystemObject") If Not FSO.FolderExists(FolderName) Then MkDir FolderName End If 'Copy every visible sheet to a new workbook For Each sh In Sourcewb.Worksheets 'If the sheet is visible then copy it to a new workbook If sh.Visible = -1 Then sh.Copy 'Set Destwb to the new workbook Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2013 If Sourcewb.Name = .Name Then MsgBox "Your answer is NO in the security dialog" GoTo GoToNextSheet Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With 'Change all cells in the worksheet to values if you want If Destwb.Sheets(1).ProtectContents = False Then With Destwb.Sheets(1).UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False End If 'Save the new workbook and close it With Destwb .SaveAs FolderName _ & "\" & Destwb.Sheets(1).Name & Format(Now - 30, "mmyyyy") & FileExtStr, _ FileFormat:=FileFormatNum .Close False End With End If GoToNextSheet: Next sh ActiveWorkbook.Close
__________________
Regards Gaurav |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Fixing the date format in a macro or VBA | Excel Worksheet Functions | |||
need help fixing macro | Excel Programming | |||
Help Fixing a Macro | Excel Programming | |||
Fixing SSN's with a macro | Excel Programming | |||
Help Fixing Coloring Macro | Excel Programming |