创建每日工作表，存档前几周工作表

在我的项目的一些背景：

我每天创造那家日报汇总和计算，我每天都在审查两个新的工作表。到目前为止，在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

创建每日工作表，存档前几周工作表

回答

相关问题