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

E

Eric Penfold

Active Member
Joined
Nov 19, 2021
Messages
424
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
When I save this workbook under a different name and folder all the worksheets disappear how can I avoid this??

VBA Code: 
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
 
Sort by date Sort by votes

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Your original code had the code for clearing the sheets if you do that before the save it should work
 
Upvote 0
I`ve had ago at clearing data see below. But this code
VBA Code: 
If Not Wb.Sheets.Count > 1
Then says error Method or data not found.
See full code below

VBA Code: 
Private Sub Workbook_Open()
Call BO_Report_Yrs
End Sub
Private Sub BO_Report_Yrs()

    Dim dte As Date
    Dim numericalDate As Integer
    Dim sourceDir As String
    Dim year As Integer
    Dim Wb As Worksheet
    Dim sht As Worksheet
    Dim Folder_exists As String
    Dim FullFileName As String
    Dim File_Name As Variant
    Dim FolderPath As String
    Dim NwFolderPath As String
    Dim FilePath As String
    Dim NwFilePath As String
    Dim Rng As Range
    Dim oFSO As Object
    Dim i As Variant, Ws As Variant
    
     Application.DisplayAlerts = False
            
            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") & " " & FilePath & ".xlsm"
                NwFullFileName = Format(Now(), "yyyy") + 1 & " " & FilePath & ".xlsm"
                FolderPath = sourceDir & "\" & year - 1 & "\" & FullFileName
                NwFolderPath = sourceDir & "\" & year & "\" & NwFullFileName
               Workbooks.Open FolderPath
                Set Wb = NwFullFileName
                For Each sht In ThisWorkbook.Worksheets
               If Not Wb.Sheets.Count > 1 Then
                  sht.Activate
                  sht.Cells.Select
                  Selection.ClearContents
                  sht.Cells(2, 1).Select
            End If
    Next sht
               ActiveWorkbook.SaveCopyAs NwFolderPath
               
                Workbooks.Open NwFolderPath
                
                Application.DisplayAlerts = True
                                  
                    End Sub
 
Upvote 0
try changing this :
VBA Code: 
               Workbooks.Open FolderPath
                Set wb = NwFullFileName
                For Each sht In ThisWorkbook.Worksheets
               If Not wb.Sheets.Count > 1 Then
                  sht.Activate
                  sht.Cells.Select
                  Selection.ClearContents
                  sht.Cells(2, 1).Select
            End If
    Next sht
               ActiveWorkbook.SaveCopyAs NwFolderPath
to:
VBA Code: 
               Workbooks.Open FolderPath
                For Each sht In ActiveWorkbook.Worksheets
                  sht.Cells.ClearContents
                Next sht
               ActiveWorkbook.SaveCopyAs NwFolderPath
 
Upvote 0
offthelip said:
try changing this :
VBA Code: 
               Workbooks.Open FolderPath
                Set wb = NwFullFileName
                For Each sht In ThisWorkbook.Worksheets
               If Not wb.Sheets.Count > 1 Then
                  sht.Activate
                  sht.Cells.Select
                  Selection.ClearContents
                  sht.Cells(2, 1).Select
            End If
    Next sht
               ActiveWorkbook.SaveCopyAs NwFolderPath
to:
VBA Code: 
               Workbooks.Open FolderPath
                For Each sht In ActiveWorkbook.Worksheets
                  sht.Cells.ClearContents
                Next sht
               ActiveWorkbook.SaveCopyAs NwFolderPath
Click to expand...
Problem is I don't want the first sheet to change. Also don't want the first row of the sheets to change.
 
Upvote 0
try this, which has an if statement to avoid the first sheet as determined by the name. and also saves the first row before rewriting over the cleared sheet:
VBA Code: 
            Workbooks.Open FolderPath
                For Each sht In ActiveWorkbook.Worksheets
                 With sht
                If .Name <> "Firstsheetname" Then
                   lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                   inarr = .Range(.Cells(1, 1), .Cells(1, lastcol)) 'copy first row to variant array
                   .Cells.ClearContents
                   .Range(.Cells(1, 1), .Cells(1, lastcol)) = inarr 'copy dfirst row back to sheet
                End If
                 End With
                Next sht
               ActiveWorkbook.SaveCopyAs NwFolderPath
 
Upvote 0
Thanks i think this is right except it goes into a spin in the for loop not sure why?

VBA Code: 
Option Explicit
Private Sub BO_Report_Yrs()

    Dim numericalDate As Integer
    Dim sourceDir As String
    Dim year As Integer
    Dim Wb As Workbook
    Dim NwWb As Workbook
    Dim sht As Worksheet
    Dim Folder_exists As String
    Dim FullFileName As String
    Dim NwFullFileName As String
    Dim File_Name As Variant, Arr As Variant
    Dim FolderPath As String
    Dim NwFolderPath As String
    Dim FilePath As String
    Dim NwFilePath As String
    Dim LCol As Long
    
    
     Application.DisplayAlerts = False
            
            year = Trim(Str(Format(Date, "yyyy"))) + 1
            
            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") & " " & FilePath & ".xlsm"
                NwFullFileName = Format(Now(), "yyyy") + 1 & " " & FilePath & ".xlsm"
                FolderPath = sourceDir & "\" & year - 1 & "\" & FullFileName
                NwFolderPath = sourceDir & "\" & year & "\" & NwFullFileName
                              
                Workbooks.Open FolderPath
                For Each sht In ThisWorkbook.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
             
                
               ActiveWorkbook.SaveCopyAs NwFolderPath
               
                Set Wb = Workbooks("FullFileName")
               Set NwWb = Workbooks("NwFullFileName")
               
               Wb.Close

              NwWb.Open
                
                Application.DisplayAlerts = True
                                  
                    End Sub
 
Upvote 0
VBA Code: 
Workbooks.Open FolderPath
                For Each sht In ThisWorkbook.Worksheets
The first of these statements will open the workbook given by FOlderPath and make it the ACTIVEWORKBOOK , the second statement loops through all the worksheets in the workbook in which the VBA code is running ( THISWORKBOOK) NOT the one you just opened. If you look at the code I posted in posts 15 and 16 I have quite specifically referred to ACTIVEWORKBOOK. I thin kyou need to change that, which might solve your problem
 
Upvote 0
I think the code is working except trying to not save previous workbook error = Named argument not found.

VBA Code: 
Private Sub BO_Report_Yrs()

    Dim numericalDate As Integer
    Dim sourceDir As String
    Dim year As Integer
    Dim Wb As Workbook
    Dim NwWb As Workbook
    Dim sht As Worksheet
    Dim Folder_exists As String
    Dim FullFileName As String
    Dim NwFullFileName As String
    Dim File_Name As Variant, Arr As Variant
    Dim FolderPath As String
    Dim NwFolderPath As String
    Dim FilePath As String
    Dim NwFilePath As String
    Dim LCol As Long
   
   
            With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            End With
                   
            year = Trim(Str(Format(Date, "yyyy"))) + 1
           
            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") & " " & FilePath & "T" & ".xlsm"
                NwFullFileName = Format(Now(), "yyyy") + 1 & " " & FilePath & ".xlsm"
                FolderPath = sourceDir & "\" & year - 1 & "\" & FullFileName
                NwFolderPath = sourceDir & "\" & year & "\" & NwFullFileName
               
                        For Each sht In ThisWorkbook.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
           
                Set Wb = ActiveWorkbook

                ActiveWorkbook.SaveCopyAs NwFolderPath
              
               Workbooks(Wb).Close SaveChages:=False

              Workbooks("NwFullFileName").Activate
               
                With Application
                .ScreenUpdating = True
                .DisplayAlerts = True
                .EnableEvents = True
                End With
                                 
                    End Sub
 
Upvote 0
VBA Code: 
Workbooks(Wb).Close SaveChages:=False
should be
VBA Code: 
Workbooks(Wb).Close SaveChanges:=False
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Need help with saving a file in a month and year folder
Replies
1
Views
606
John_w
J
E
  • Question
Trying to use index match method
Replies
7
Views
550
RoryA
RoryA
B
  • Question
Save as PDF, add month folder
Replies
1
Views
577
John_w
J
E
  • Question
Trim Function
Replies
3
Views
511
nemmi69
nemmi69
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
345
Agnarr
Agnarr

Forum statistics

Threads
1,214,940
Messages
6,122,361
Members
449,080
Latest member
Armadillos

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top