excel - VBA在每个月初复制excel表格并创建新的工作簿

Question

我写了一个VBA宏来每天创建一个excel工作表的副本，并用日期命名工作表，我将复制下面的代码，它工作得很好。但是，我正在尝试改进宏，以便在每个月初创建一个新的工作簿。为此，我在日期 = 1 时创建当前工作簿的副本，删除上个月的所有工作表，然后开始为新月份复制。这个宏在每个月初创建一个工作簿并删除所有以前的工作表，但是，当它复制工作表时，它会为每个工作表创建两个副本（这只发生在它通过 if 条件时，否则如果我们在月中旬，它工作正常），这令人沮丧，我试图理解这个问题，但我无法弄清楚。

这是仅复制工作表的代码（完美运行）

        Sub AdddayWkst()
'**Declaring variables and their types**
Dim wsM As Worksheet '*Master worksheet*
Dim strName As String '*String name = work sheet name*
Dim wsMDate As Date '*Master worksheet date*
Dim todayDate As Date  '*Current date*
Dim intYear As Integer '*Year of master worksheet date*
Dim intMonth As Integer '*Month of master worksheet date*
Dim intDay As Integer '*Day of master worksheet date*


On Error Resume Next '*command to prevent crashing, so in case of error, skip the line that is causing the error and perform the next command*
Set wsM = Worksheets(1) '*Set the leftmost (most recent) sheet to the variable wsM*
wsMDate = CDate(Worksheets(1).name) '*Convert the name of the leftmost (master) worksheet into date format*
todayDate = Date '*Set the current date in todayDate parameter*
intYear = Year(wsMDate) '*Save the year of master sheet in intYear*
intMonth = Month(wsMDate) '*Save the Month of master sheet in intMonth*
intDay = Day(wsMDate) '*Save the Day of master sheet in intDay* Needed to increment the days
strName = Format(DateSerial(intYear, intMonth, intDay + 1), "mm-dd-yyyy") '*increment the date of the original master sheet by 1 day, save it in strName to be used as the name of the new copied sheet*
TimeSheet (wsMDate) '*run the function timesheet to update the time sheet* Function details are below

Do While wsMDate < todayDate '*repeat the instructions inside this loop as long as the date of the master sheet (leftmost sheet) is less than the current date*
        wsM.Copy before:=Sheets(1) '*Copy the Master worksheet and place the copy before the leftmost sheet*
        set wsM = ActiveSheet '*the new copy is now set as the master sheet*
        'wsM = Worksheets(1)
        wsMDate = DateSerial(intYear, intMonth, intDay + 1) '*increase the date by one day to prepare for the next copy until this date is equal to the current date
        strName = Format(DateSerial(intYear, intMonth, intDay + 1), "mm-dd-yyyy") '*the name is also incremented by one day and set to the desired format
        'Cells(2, 16) = strName
        intYear = Year(wsMDate) '*update the year value after increasing the date
        intMonth = Month(wsMDate) '*update the month value after increasing the date
        intDay = Day(wsMDate) '*update the day value after increasing the date
        ActiveSheet.name = strName '*set the name of the new copy to (strName) value
        TimeSheet (wsMDate) '*run the time sheet function to update the time sheet in every copied sheet
Loop

Set wsM = Nothing

End Sub

这是应该在每个月初创建一本新书的代码：

Sub AdddayWkst()
'**Declaring variables and their types**
Dim wsM As Worksheet '*Master work sheet*
Dim xWs As Worksheet '*Deleted work sheet*
Dim strName As String '*String name = work sheet name*
Dim strMonthB As Integer '*Month before incrementing the day*'
Dim strMonthA As Integer '*Month after incremnting the day*'
Dim wsMDate As Date '*Master worksheet date*
Dim todayDate As Date '*Current date*'
Dim intYear As Integer '*Year of master worksheet date*
Dim intMonth As Integer '*Month of master worksheet date*
Dim intDay As Integer '*Day of master worksheet date*
Dim a As Variant
Dim b As Variant



On Error Resume Next '*command to prevent crashing, so in case of error, skip the line and perform the next command*
Set wsM = Worksheets(1) '*Set the leftmost (most recent) sheet to the variable wsM*
wsMDate = CDate(wsM.Name) '*Convert the name of the leftmost (master) worksheet into date format*
todayDate = Date '*Set the current date in todayDate parameter*
intYear = Year(wsMDate) '*Save the year of master sheet in intYear*
intMonth = Month(wsMDate) '*Save the Month of master sheet in intMonth*
intDay = Day(wsMDate) '*Save the Day of master sheet in intDay* Needed to increment the days
strMonthB = intMonth '*Save the month of the leftmost sheet as the month before incrementing* Needed to detemine if new book is needed
strName = Format(DateSerial(intYear, intMonth, intDay + 1), "mm-dd-yyyy") '*increment the date of the original master sheet by 1, save it in strName to be used as the name of the new copied sheet*
strMonthA = Month(CDate(strName)) '*convert strName to date format and get the month of it* Comparing this month to the (strMonthB) before month to determine if new month started; hence a new workbook need to be created
'Cells(2, 20) = strMonthB
'Cells(2, 21) = strMonthA
'Cells(2, 21) = strName
'Cells(3, 21) = wsMDate
'Cells(20, 20) = strName

a = DateDiff("d", wsMDate, Now)
For b = 1 To a '*repeat the instructions inside this loop as long as the date of the master sheet (leftmost sheet) is less than the current date*
'Cells(2, 22) = strName
'Cells(3, 22) = wsMDate


        If strMonthA > strMonthB And Day(CDate(strName)) = 1 Then '*If a new month starts then perform the below commands*

        Set wsM = Worksheets(1)
        'Cells(2, 23) = strName
        'Cells(3, 23) = wsMDate
        ActiveWorkbook.SaveCopyAs "C:\Users\Documents\xxx.xlsm" '*Create a copy of the current workbook in the specified directory*
        Workbooks.Open Filename:="C:\Users\Documents\xxx.xlsm" '*Open the new workbook*
        Application.DisplayAlerts = False '*Stop popup messages* Needed to prevent Excel from asking for confirmation to delete sheets
        'wsM.Copy before:=Workbooks("C:\Users\Documents\xxx.xlsm").Sheets(1)
        'wsM.Copy before:=Worksheets(1)
        For Each xWs In Application.ActiveWorkbook.Worksheets '*go through each and every sheet in the newly copied workbook*
        If Month(CDate(xWs.Name)) <> Month(todayDate) Then '*if the montth of the sheet does not equal the current month, delete that sheet*
            xWs.Delete
        End If
        Next
        Application.DisplayAlerts = True '*Allow popup messages once again*
        'wsM.Copy before:=Worksheets(1)
        End If
        
        wsM.Copy before:=Worksheets(1)
        Set wsM = Worksheets(1)
        strMonthB = intMonth '*update the month value with each iteration*
        'Cells(2, 24) = strName
        'Cells(3, 24) = wsMDate
        wsMDate = DateSerial(intYear, intMonth, intDay + 1) '*increment the days with 1 with each iteration*
        strName = Format(DateSerial(intYear, intMonth, intDay + 1), "mm-dd-yyyy") '*name of sheet also incremented with each iteration*
        strMonthA = Month(CDate(strName)) '*update the month after incrementing the day*
        'Cells(2, 20) = strMonthB
        'Cells(2, 21) = strMonthA
        'Cells(3, 20) = wsMonth
        'Cells(3, 21) = Month(todayDate)
        'Cells(2, 16) = strName
        'Cells(3, 25) = wsMDate
        intYear = Year(wsMDate)
        intMonth = Month(wsMDate)
        intDay = Day(wsMDate)
        ActiveSheet.Name = strName '*Set the name of the active sheet to be the strName*


Next

Set wsM = Nothing

End Sub

标签： excelvba