excel 根据日期自动保存和自动创建新工作表

uoifb46i  于 2023-04-07  发布在  其他
关注(0)|答案(2)|浏览(191)

超级新的excel和这个代码的东西,所以请对我放松。。我有一个工作簿,其中包含一个工作表显示每月的数字。我试图创建一个VBA,当我的工作簿打开时,VBA将检查当前日期,并将自动保存和创建一个新的“空白”副本,该特定的每月工作表,保留该表中的一切(公式,格式,单元格大小和宽度,等)除了我已经输入了当月的销售数字.本质上给我一个新的模板输入新的销售数据..为了进一步解释,当我打开工作簿,如果它检测到日期是第一个月,它应该保存当前的月度工作表,将其标记为上个月(因为从技术上讲,它将填充上个月的数据),然后在保存后,它应该从以前的工作表创建一个新的模板,并将新的新模板插入工作簿,删除旧的。但是如果工作表打开,VBA检测到当前日期不是该月的第一天,那么VBA应该停止运行。
我已经为此工作了将近一个星期了,但没有得到任何荣耀。我搜索了youtube,其他网站,也做了很多很多的谷歌搜索。我利用了一些代码,我发现类似的任务和排序修改它,以我的场景,但我一直陷入什么似乎是最简单的事情。我只是似乎不能包裹我的头周围如何实现我想做的事情。
这两个宏的工作,因为他们应该当手动运行.一个宏保存工作表和另一个宏创建一个新的工作表.令人沮丧的是,我不知道如何使它,使两个宏的检查当前日期之前,做任何其他事情,然后,只有当日期返回为每月的第一,如果宏的继续..否则他们应该停止.并做它自动每次打开工作簿.
无论如何,这是我目前正在使用的代码,我把我的代码分成两个不同的宏,所以有些代码不同。

Sub WorksheetExport()

    Dim ws As Worksheet
    Dim wsToSave As Worksheet
    Dim filePathToSave As String
    Dim strName As String
    Dim bCheck As Boolean
    Dim wsMaster As Worksheet
    
    Application.ScreenUpdating = False
    
    
    
    strName = Format(Date, "_mmyyyy")
    Set wsMaster = Worksheets("bqtest")
    
    filePathToSave = "C:\Users\thelo\Desktop\Quail Stuff\TEST\"
    
    Set wsToSave = Worksheets("bqtest")
    
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=filePathToSave & wsToSave.Name & strName & ".pdf"

End Sub
Sub CreateNewSheetWithMonth()

    Dim ws As Worksheet
    Dim wsM As Worksheet
    Dim strName As String
    Dim bCheck As Boolean

    On Error Resume Next
    Set wsM = Sheets("bqtest")
    strName = Format(Date, "_mmyyyy")
    bCheck = Len(Sheets("bqtest" & strName).Name) > 0

    If bCheck = False Then
   
    wsM.Copy After:=Sheets(1)
    ActiveSheet.Name = "bqtest" & strName

End If

    Set wsM = Nothing

End Sub
gmxoilav

gmxoilav1#

Private Sub Workbook_Open()
    Dim latestSheetName As String, monthstr As String
    Dim currentMonth As Integer, currentYear As Integer, latestYear As Integer, latestMonth As Integer, lMonth As Integer, lYear As Integer
    Dim lastRow As Long
    Dim sheet As Worksheet
    
    ' Get the current year and month
    currentMonth = Format(Date, "mm")
    currentYear = Format(Date, "yyyy")
    
    If Len(CStr(currentMonth)) < 2 Then
        monthstr = "0" & currentMonth
    Else
        monthstr = currentMonth
    End If
    
    ' Loop through all sheets and find the latest one
    lMonth = 0
    lYear = 0
    For Each sheet In ThisWorkbook.Sheets
        If sheet.Name Like "bqtest_######" Then
            latestYear = Right(sheet.Name, 4)
            latestMonth = Mid(sheet.Name, 8, 2)
            If latestMonth > lMonth Or latestYear > lYear Then
                latestSheetName = sheet.Name
                lYear = latestYear
                lMonth = latestMonth
            End If
        End If
    Next sheet
    
    ' Check if the latest sheet is older than the current year and month
    If currentYear = lYear Or currentMonth > lMonth Then
        Worksheets(latestSheetName).Copy After:=Worksheets(ThisWorkbook.Sheets.Count)
            ActiveSheet.Name = "bqtest_" & monthstr & currentYear
            lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
            'clear range starting at A2 to last row change accordingly
            ActiveSheet.Range("A2").Resize(lastRow - 1).ClearContents
    ElseIf currentYear > lYear Then
        Worksheets(latestSheetName).Copy After:=Worksheets(ThisWorkbook.Sheets.Count)
           ActiveSheet.Name = "bqtest_" & monthstr & currentYear
            lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
            'clear range starting at A2 to last row change accordingly
            ActiveSheet.Range("A2").Resize(lastRow - 1).ClearContents
    End If
End Sub
cpjpxq1n

cpjpxq1n2#

Sub CreateNewSheetWithMonth()

    Dim ws As Worksheet
    Dim strToday As String
    Dim bCheck As Boolean
    Const strTARGET_PATH = "C:\Users\thelo\Desktop\Quail Stuff\TEST\"

    'activate the worksheet bqtest... (the workbook may contain other sheets, too)
    For Each ws In ThisWorkbook.Worksheets 'check each worksheet
        If InStr(ws.Name, "bqtest") = 1 Then 'if sheet name starts with "bqtest"
            ws.Activate         'activate it
        End If
    Next ws

    'check if a worksheet exists for this month
    strToday = Format(Date, "_mmyyyy") 'format today's date
    On Error Resume Next        'avoid error if not existing
    bCheck = Len(Sheets("bqtest" & strToday).Name) > 0  'check if exists
    On Error GoTo 0             'restore error checking
    
    'take action if new month
    If bCheck = False Then      'skip if worksheet exists
        'save last month's worksheet as PDF
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
          Filename:=strTARGET_PATH & ActiveSheet.Name & ".pdf"
        
        'copy ActiveSheet and paste it after ActiveSheet, activate it
        ActiveSheet.Copy After:=ActiveSheet
        ActiveSheet.Name = "bqtest" & strToday 'rename to this month
    End If

End Sub

这基本上是你的代码,删除了一些不必要的代码。
我已经更改了它,以便它在其名称下导出上个月的工作表,例如2023年3月的bqtest_032003.pdf
在您的代码中,没有删除旧月份的工作表。如果您希望VBA自动执行此操作,请删除行ActiveSheet.Copy After:=ActiveSheet。然后旧工作表将重命名为新月份,而不是复制。
你提到你想在新的一个月里删除销售数据,要么你手工做,要么你自己写代码,因为我不知道这些数据写在哪里。
希望这次能成功。

相关问题