If new year then the code will run but all sheets disappear?

[Eric Penfold]

When I save this workbook under a different name and folder all the worksheets disappear how can I avoid this??

Private Sub BO_Report_Yrs()

    Dim dte As Date
    Dim numericalDate As Integer
    Dim sourceDir As String
    Dim year As Integer
    Dim Wb As Workbook
    Dim Folder_exists As String
    Dim FullFileName As String
    Dim File_Name As Variant
    Dim FolderPath As String
    Dim FilePath As String
    Dim ws As Worksheet
    Dim Rng As Range


     Set ws = ActiveSheet

         If ws.Name <> "Summary" And ws.Name <> "Trend" And ws.Name <> "Supplier BO" And ws.Name <> "Dif Depot" _
         And ws.Name <> "BO Trend WO" And ws.Name <> "BO Trend WO 2" And ws.Name <> "Different Depot" Then

            Set Wb = Workbooks.Add
            
            year = Trim(Str(Format(Date, "yyyy"))) + 1
                
            dte = Now()
            
            numerical_date = Int(CDbl(dte))
            
            sourceDir = "S:\PURCHASING\Stock Control\Alton"
            
            Folder_exists = Dir(sourceDir & "\" & year, vbDirectory)
            If Folder_exists = "" Then
                MkDir sourceDir & "\" & year
                Folder_exists = Dir(sourceDir & "\" & year, vbDirectory)
            End If
            
            FilePath = "Alton Back Order"
                FullFileName = Format(Now(), "yyyy") + 1 & " " & FilePath
                FolderPath = sourceDir & "\" & year & "\" & FullFileName
            
            Wb.SaveAs FolderPath
            
            For Each ws In Wb.Worksheets
                Set Rng = ws.Range("A2").CurrentRegion.Select
                Selection.Clear
                Next ws
            
    End If

End Sub

 

[Eric Penfold]

Workbooks(Wb).Close SaveChanges:=False

Now says runtime error 13

 

[offthelip]

try:

Wb.Close SaveChages:=False

 

[Eric Penfold]

Thanks for your time your code works.
I`ve managed so sort this code would you like to see the full code?

 

[offthelip]

Yes , do post the code , so that anybody trying to do the same thing or with similar problems can see the final solution . Glad I could help

 

[Eric Penfold]

Here you are

Public Sub BO_Report_Yrs()

 
    Dim sourceDir As String
    Dim Yr As String
    Dim Month As String
    Dim Wb As Workbook
    Dim NwWb As Workbook
    Dim sht As Worksheet
    Dim Folder_exists As String
    Dim FullFileName As String
    Dim File_Name As Variant, Arr As Variant
    Dim FolderPath As String
    Dim FilePath As String
    Dim NwFilePath As String
    Dim LCol As Long
    
    
            With Application
            .ScreenUpdating = False
            .Calculation = xlManual
            .DisplayAlerts = False
            .EnableEvents = False
            End With
                    
            Yr = Trim(Str(Format(Date, "yyyy"))) + 1
            
            sourceDir = "S:\PURCHASING\Stock Control\Grays"
            
            Month = Format(Date, "mmmm")
            
            Folder_exists = Dir(sourceDir & "\" & Yr, vbDirectory)
            If Month = "December" Then
            If Folder_exists = Yr Then GoTo Application
            If Folder_exists = "" Then
                MkDir sourceDir & "\" & Yr
                Folder_exists = Dir(sourceDir & "\" & Yr, vbDirectory)
            End If
            
                FilePath = "Grays Back Order"
                FullFileName = Format(Now(), "yyyy") + 1 & " " & FilePath & ".xlsm"
                FolderPath = sourceDir & "\" & Yr & "\" & FullFileName
                                 
                Set Wb = ThisWorkbook
                Wb.SaveAs FolderPath, xlOpenXMLWorkbookMacroEnabled
                
                Set NwWb = Workbooks.Open(FolderPath)
                
                        For Each sht In NwWb.Worksheets
                        With sht
                        If .Name <> "Summary" Then
                         LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                           Arr = .Range(.Cells(1, 1), .Cells(1, LCol))
                           .Cells.ClearContents
                           .Range(.Cells(1, 1), .Cells(1, LCol)) = Arr
                        End If
                End With
            Next sht
            
             MsgBox "New Years BO Workbook saved", vbInformation
             
Application:
            With Application
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
            .DisplayAlerts = True
            .EnableEvents = True
            End With
    End If
             

                                  
                    End Sub