創建每日工作表，存檔前幾周工作表

在我的項目的一些背景：

我每天創造那家日報彙總和計算，我每天都在審查兩個新的工作表。到目前爲止，在excel文件中打開的工作表太多了，因此需要永遠打開併發送給人員。

最終，我想知道如何將上週創建的任何工作表保存到另一個文件。我想將這些全部保存在單獨的（單個）工作簿中，或者以某種方式創建一個文件夾來保存每週的每一天的每個工作簿。

因此，例如，我爲本週創建了10個工作表（每星期一至星期五的每一天爲2個）。然後，當我在下週一進入並開始創建該周的工作表時，舊工作表將被放入另一個工作簿中。

我現在每天都在使用創建的工作表中的代碼：

TD = Format(Date, "yyyy.mm.dd") 

On Error GoTo Make_Sheet 
    Sheets("Open_" & TD).Activate 

    Sheets("Open_" & TD).Select 
    Cells.Select 
    Selection.Delete Shift:=x1Up 
Exit Sub 

    Make_Sheet: 
     Worksheets.Add(After:=Sheets("Print")).Name = "Open_" & TD 
     ActiveSheet.Name = "Open_" & TD 

With ActiveWorkbook.Sheets("Open_" & TD).Tab 
    .Color = 5296274 
    .TintAndShade = 0 
End With

的代碼將檢查如果當前日期的工作表已經存在（使用日期作爲工作表的標題），如果它它清除它。否則，它將創建新的工作表。它也將爲選項卡着色代碼（因爲我每天創建2個）。我有另一組相同的代碼來創建第二個日常工作表。

由於提前，

-Tuques

來源

2017-10-05 Jeremy Ashton

這就是所有那些使它變慢的「激活」和「選擇」。重構代碼以不使用這些東西......例子..'Cells.Delete Shift：= x1Up'與使用select在兩行中執行相同的操作。 – braX

與您的問題無關，但將'Shift：= x1Up'更改爲'Shift：= xlUp' – YowE3K

這裏是所有表複製到新的工作簿，保存並關閉新工作簿的宏。刪除除第一張之外的所有紙張，然後清除剩餘紙張的內容。不確定要保留的紙張。

Sub New_week() 
NWeek = MsgBox("Is this the start of a new week?", vbYesNo + vbQuestion) 

    If NWeek = 6 Then 

     Dim fname As String 
     'Create new Workbook name. 
     'Add path if you want it in a specific folder 
    fname = "Week" & Format(Date, "yyyy_mm_dd") & ".XLSX" 
     'copy all sheets 
    Sheets.Copy 
     'save to new file 
     With ActiveWorkbook 
     .SaveAs FileName:=fname, FileFormat:=xlOpenXMLWorkbook 
     .Close SaveChanges:=False 
     End With 

    'Delete all sheets except first 
    Application.DisplayAlerts = False 
     Do While Worksheets.Count > 1 
     Worksheets(2).Delete 
     Loop 
    Application.DisplayAlerts = True 
    'Clear contents of first sheet 
    Sheets(1).UsedRange.Clear 

    End If

來源

2017-10-05 20:42:30 mooseman

創建每日工作表，存檔前幾周工作表

回答

相關問題