创建每日工作表,存档前几周工作表
问题描述:
我想弄清楚如何存档周旧的工作表。创建每日工作表,存档前几周工作表
在我的项目的一些背景:
我每天创造那家日报汇总和计算,我每天都在审查两个新的工作表。到目前为止,在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
答
这里是所有表复制到新的工作簿,保存并关闭新工作簿的宏。删除除第一张之外的所有纸张,然后清除剩余纸张的内容。 不确定要保留的纸张。
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
这就是所有那些使它变慢的“激活”和“选择”。重构代码以不使用这些东西......例子..'Cells.Delete Shift:= x1Up'与使用select在两行中执行相同的操作。 – braX
与您的问题无关,但将'Shift:= x1Up'更改为'Shift:= xlUp' – YowE3K