View Single Post
 
Old 09-09-2018, 03:44 PM
Khwaja Khwaja is offline Windows 10 Office 2016
Novice
 
Join Date: Aug 2018
Posts: 12
Khwaja is on a distinguished road
Default

Thanks. I tried this too. Still don't see anything in the immediate window. I have copied the entire code below if this helps:

Code:
Sub CopyWorksheet()
    
    Dim MyFileName As String
    Dim NewName As String
    Dim nm As Name
    Dim ws As Worksheet
    Dim aThisFilename As String
    Dim CurrentWB As Workbook

    Set CurrentWB = ActiveWorkbook
    

    'If MsgBox("Copy specific sheet to a new workbook" & vbCr & _
    '"New sheet will be pasted as values, named ranges removed" _
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub

    With Application
        .ScreenUpdating = False

         '       Copy specific sheets
         '       *SET THE SHEET NAMES TO COPY BELOW*
         '       Array("Sheet Name", "Another sheet name", "And Another"))
         '       Sheet names go inside quotes, seperated by commas
        On Error GoTo ErrCatcher
        Sheets(Array("Sheet1")).Copy
        On Error GoTo 0

         '       Paste sheets as values
         '       Remove External Links, Hperlinks and hard-code formulas
         '       Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select

         '       Remove named ranges
        For Each nm In ActiveWorkbook.Names
            nm.Delete
        Next nm

         '       Input box to name new file
        'NewName = InputBox("Please Specify the name of your new workbook", "New Copy")

         '       Save it with the NewName and in the same directory as original
        'ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xlsx"
        'ActiveWorkbook.Close SaveChanges:=False
    
    'MyFileName = CurrentWB.Path & "\QBO Uploads\" & "Toongabbie Roster - " & Format(Now(), "dd-mm-yyyy") & ".csv"
    MyFileName = CurrentWB.Path & "\QBOUploads\" & Sheets("Analysis").Range("I1").Value & Format(Now(), "dd-mm-yyyy") & ".csv"
    
    MsgBox MyFileName
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    ActiveWorkbook.Close SaveChanges:=False
    Application.DisplayAlerts = True

    MsgBox "CSV file has been created "
    'ActiveWindow.Close
    
    
        .ScreenUpdating = True
    End With
    Exit Sub

ErrCatcher:
    MsgBox "Specified sheet does not exist within this workbook"

End Sub
Attached Files
File Type: pdf error.pdf (179.4 KB, 8 views)
Reply With Quote