Opslaan via macro met als bestandsnaam de sheetnaam

[FvdF]

Beste forumleden,

Wie helpt mij met het volgende? Ik wil excel sheets opslaan als nieuw werkblad met de naam van dit sheet.

Bijvoorbeeld:
Sheet 1 heet "Januari" dus het opgeslagen nieuwe excel bestand heet ook Januari.xlsm
Sheet 2 heet "Februari" dus het opgeslagen nieuwe excel bestand heet ook Februari.xlsm

Elk nieuw excel bestand bestaat enkel uit dat ene sheet.

Mvgr,
FvdF

 

[OctaFish]

Deze macro van Ron de Bruin (voor het versturen via Outlook van een werkblad) kun je prima gebruiken voor dat klusje:

Sub Mail_ActiveSheet()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010
Dim FileExtStr As String, shtName As String
Dim FileFormatNum As Long
Dim SourceWB As Workbook
Dim DestWB As Workbook
Dim TempFilePath As String
Dim TempFileName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set SourceWB = ActiveWorkbook
    ' Next, copy the sheet to a new workbook.
    shtName = ActiveSheet.Name
    ActiveSheet.Copy
    Set DestWB = ActiveWorkbook
    With DestWB
        ' For Excel 2007-2010, exit the subroutine if you answer NO in the security dialog
        ' that is displayed when you copy a sheet from an .xlsm file with macros disabled.
        If SourceWB.Name = .Name Then
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
            MsgBox "You answered 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 With

    ' You can use the following statements to change all cells in the worksheet to values.
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

    ' Save the new workbook, mail, and then delete it.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = shtName & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    With DestWB
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        .Close SaveChanges:=False
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

De check op de juiste versie kun je natuurlijk ook inkorten.