+ Reply to Thread
Results 1 to 2 of 2

Save worksheet as seperate workbook problem- File name issue

Hybrid View

  1. #1
    Registered User
    Join Date
    08-12-2009
    Location
    Cardiff, Wales
    MS-Off Ver
    Excel 2007
    Posts
    53

    Save worksheet as seperate workbook problem- File name issue

    I am using the following code attached to a button to save the worksheet as a seperate workbook. The problem I have is if I try to use a range for the filename then the code crashes! Should be simple but cant get it to work?
    Sub Save_ActiveSheet_NoCode()
    'Working in 97-2010
        Dim FileExtStr As String
        Dim FileFormatNum As Long
        Dim Sourcewb As Workbook
        Dim Destwb As Workbook
        Dim FilePath As String
        Dim FileName As String
        Dim I As Long
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        Set Sourcewb = ActiveWorkbook
    
        'Copy the sheet to a new workbook
        ActiveSheet.Copy
        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-2010, we exit the sub when your answer is
                'NO in the security dialog that you only see  when you copy
                'an sheet from a xlsm file with macro's disabled.
                If Sourcewb.Name = .Name Then
                    With Application
                        .ScreenUpdating = True
                        .EnableEvents = True
                    End With
                    MsgBox "Your answer is NO in the security dialog"
                    Exit Sub
                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
            With Destwb.Sheets(1).UsedRange
                .Cells.Copy
                .Cells.PasteSpecial xlPasteValues
                .Cells(1).Select
            End With
            Application.CutCopyMode = False
            
            
     Dim shp As Shape
     Dim myVar As Shapes
     
    ActiveSheet.Activate
     Count = ActiveSheet.Shapes.Count
     
    'Set myVar = Sheets(ActiveSheet.Name).Shapes
     For I = Count To 1 Step -1
     ActiveSheet.Shapes(I).Delete 'myVar(i).Delete
     Next I
     
                
    
        'Save the new workbook
        FilePath = "C:\Folder Name\Folder Name\"
        FileName = "File Name"
    
        With Destwb
            .SaveAs FilePath & FileName & FileExtStr, _
                    FileFormat:=FileFormatNum
            On Error Resume Next
          
            On Error GoTo 0
            .Close SaveChanges:=True
        End With
    
     
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub
    If I replace this line:
    FileName = "File Name"
    with this line I thought it would be that simple?
    FileName = Range ("B3").Value
    But then it doesnt seem to like this:
    .SaveAs FilePath & FileName & FileExtStr, _
                    FileFormat:=FileFormatNum
    would be nice if I could also add the date and time to the file name so multiple copies can be saved without overwriting, is this possible?
    Hopfully someone can help me
    Thanks
    Andrew

  2. #2
    Forum Guru Norie's Avatar
    Join Date
    02-02-2005
    Location
    Stirling, Scotland
    MS-Off Ver
    Microsoft Office 365
    Posts
    19,644
    Andrew

    You have no worksheet or workbook reference for Range("B3").

    Try adding them to make sure the code is looking in the correct worksheet/workbook.
    If posting code please use code tags, see here.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1