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
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
You add a new workbook with this statement:
VBA Code: 
Set Wb = Workbooks.Add
then save it with this one:
VBA Code: 
Wb.SaveAs FolderPath
but in between you haven't written or copied anything into it so it will be blank!!
 
Upvote 0
I`ve tried to copy sheets over but same result?

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 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
    ReDim Worksheets(18)
            Worksheets(1) = "Summary"
            Worksheets(2) = "Trend"
            Worksheets(3) = "Supplier BO"
            Worksheets(4) = "Jan"
            Worksheets(5) = "Feb"
            Worksheets(6) = "Mar"
            Worksheets(7) = "April"
            Worksheets(8) = "May"
            Worksheets(9) = "Jun"
            Worksheets(10) = "Jul"
            Worksheets(11) = "Aug"
            Worksheets(12) = "Sep"
            Worksheets(13) = "Oct"
            Worksheets(14) = "Nov"
            Worksheets(15) = "Dec"
            Worksheets(16) = "BO Trend WO"
            Worksheets(17) = "BO Trend WO 2"
            Worksheets(18) = "Diff Depot"
            
            year = Trim(Str(Format(Date, "yyyy")))
                
            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 & "\" & FullFileName
                NwFolderPath = sourceDir & "\" & year + 1 & "\" & NwFullFileName
                
            Set Wb = Workbooks.Add

              For i = 1 To UBound(Worksheets)
                     Workbooks(FullFileName).Sheets(Worksheets(i)).Copy _
                    After:=Workbooks(NwFullFileName).Sheets(Workbooks(NwFullFileName).Sheets.Count)
                      Next i
                      
            Wb.SaveAs NwFolderPath
                                    
        End Sub
 
Upvote 0
your code for copying the workbook is in error: this code copies the workbook with VBa in it to a new workbook once it is copied you can save it:
VBA Code: 
Dim Wb As Workbook
Set Wb = Workbooks.Add

              For i = 1 To ThisWorkbook.Worksheets.Count
                    ThisWorkbook.Worksheets(i).Copy Wb.Worksheets(Worksheets.Count)
              Next i
 
Upvote 0
Any chance of making it work your end sorry struggling to understand
 
Upvote 0
I`ve done some more work on this and it copies the sheets over to new sheet

But 3 issues

Why will it not save
Why can I not delete sheet1 from destination workbook
All sheets fill in back to front

VBA Code: 
Private Sub BO_Report_Yrs()

    Dim dte As Date
    Dim Wb As Workbook
    Dim numericalDate As Integer
    Dim sourceDir As String
    Dim year As Integer
    Dim Folder_exists As String
    Dim FullFileName As Variant
    Dim NwFullFileName 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, arrNames
    Dim Sh As Worksheet

            
            year = Trim(Str(Format(Date, "yyyy")))
                
            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 & "\" & FullFileName
                NwFolderPath = sourceDir & "\" & year + 1 & "\" & NwFullFileName
                
            Set NwFullFileName = Workbooks.Add()
            arrNames = VBA.Array("Summary", "Trend", "Supplier BO", "Jan", "Feb", "May", "April", "May", "Jun", "Aug", "Sep", "Oct", "Nov", "Dec", "BO Trend WO", "BO Trend WO 2", "Diff Depot")
            For i = 0 To 18
                Set Sh = Nothing
                On Error Resume Next
                Set Sh = ThisWorkbook.Sheets(arrNames(i))
                On Error GoTo 0
                If Not Sh Is Nothing Then
                    Sh.Copy Before:=NwFullFileName.Sheets(1)
                End If
            Next i
            
            Set Wb = NwFullFileName
            With Wb
            .Sheet(1).Delete
            .Save
            End With
            
            End Sub
 
Upvote 0
I am struggling to understand too!! I don't really know what you are trying to do,
Are you trying to copy and rename a file from folder FolderPath to NwFolderpath? Because there is a much easier way of doing that.
 
Upvote 0
offthelip said:
I am struggling to understand too!! I don't really know what you are trying to do,
Are you trying to copy and rename a file from folder FolderPath to NwFolderpath? Because there is a much easier way of doing that.
Click to expand...
Yes that`s right but with all the sheets & coding included.
Please read the above thanks
 
Upvote 0
In which case all you need to do is open the workbook and save it with the new name . Assuming you have got the correct paths in your two vairables this whould work:
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 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
            
            year = Trim(Str(Format(Date, "yyyy")))
                
            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 & "\" & FullFileName
                NwFolderPath = sourceDir & "\" & year + 1 & "\" & NwFullFileName
               Workbooks.Open FolderPath
               ActiveWorkbook.SaveCopyAs NwFolderPath
                                    
        End Sub
 
Upvote 0
Sorry needs to create a folder and save to that folder on the first working day of every new year. At the moment it won`t create a new folder
Also needs to clear all values but not formulas from all sheets except headers.
Otherwise brilliant thanks.
 
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
611
John_w
J
E
  • Question
Trying to use index match method
Replies
7
Views
562
RoryA
RoryA
B
  • Question
Save as PDF, add month folder
Replies
1
Views
581
John_w
J
E
  • Question
Trim Function
Replies
3
Views
517
nemmi69
nemmi69
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
373
Agnarr
Agnarr

Forum statistics

Threads
1,215,429
Messages
6,124,840
Members
449,193
Latest member
MikeVol

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