VBA复制工作表过滤数据生成每周工时卡并保存问题咨询

原代码核心问题 #

• 已声明的Tasks、TargetSheet工作表对象未完成赋值，With Tasks代码块无实际作用，全程依赖ActiveSheet定位操作对象，运行时极易出现范围偏差
• 筛选后的数据复制粘贴逻辑被注释，无法完成源数据到工时卡的同步
• 缺少工时卡生成后按指定名称另存的逻辑
• 路径、工作表名均为硬编码，可根据实际使用场景调整

修复后完整代码 #

Public Sub Create_Timecard()
' 从TaskDataBase筛选数据生成对应人员的每周工时卡
Dim WorkflowRTE_07 As Workbook
Dim TimecardRTE0 As Workbook
Dim Tasks As Worksheet
Dim TargetSheet As Worksheet

Dim WorkflowRTEPath As String
Dim TimecardRTEPath As String
Dim SavePath As String

Dim TimecardWEDate As String, TimecardEstimID As String, TimecardFilename As String
Dim Lastrow As Long

' 配置路径，可根据实际存放位置修改
WorkflowRTEPath = "C:\Users\Deb\Documents\_EXCEL\WorkflowRTE\WorkflowRTE_07.xlsx"
TimecardRTEPath = "C:\Users\Deb\Documents\_EXCEL\WorkflowRTE\TimecardRTE0.xlsx"
SavePath = "C:\Users\Deb\Documents\_EXCEL\WorkflowRTE\生成工时卡\" ' 建议单独建文件夹存放生成的工时卡，可自行修改

' 绑定工作簿、工作表对象
Set WorkflowRTE_07 = ThisWorkbook ' 宏在当前工作簿运行直接绑定
Set TimecardRTE0 = Workbooks.Open(TimecardRTEPath)
Set Tasks = WorkflowRTE_07.Worksheets("你的任务数据表名称") ' 此处修改为你存放TaskDataBase的工作表实际名称
Set TargetSheet = TimecardRTE0.Worksheets("Timesheet")

' 获取用户输入参数
TimecardWEDate = InputBox("请输入工时卡周末日期", "输入日期", "YYYYMMDD")
TimecardEstimID = InputBox("请输入工时卡所属估算师ID，示例：Estim99", "输入人员ID", "请输入ID")
TimecardFilename = TimecardWEDate & "_" & TimecardEstimID & ".xlsx"
MsgBox "正在生成工时卡：" & TimecardFilename

With Tasks
    ' 清除现有筛选
    .AutoFilterMode = False
    ' 获取数据表最大行
    Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    MsgBox "数据表最大行号为：" & Lastrow
    
    ' 按条件筛选表格
    With .ListObjects("TaskDataBase").Range
        .AutoFilter Field:=5, Criteria1:=TimecardEstimID
        .AutoFilter Field:=12, Criteria1:="=In Progress", Operator:=xlOr, Criteria2:="=Not Started"
    End With
    
    ' 复制可见数据到工时卡对应列
    .Range(.Cells(2, 1), .Cells(Lastrow, 1)).SpecialCells(xlCellTypeVisible).Copy Destination:=TargetSheet.Range("C2")
    .Range(.Cells(2, 2), .Cells(Lastrow, 2)).SpecialCells(xlCellTypeVisible).Copy Destination:=TargetSheet.Range("D2")
    .Range(.Cells(2, 5), .Cells(Lastrow, 5)).SpecialCells(xlCellTypeVisible).Copy Destination:=TargetSheet.Range("B2")
    
    ' 清除筛选恢复原表状态
    .AutoFilterMode = False
End With

' 另存新工时卡，不影响原模板
TimecardRTE0.SaveAs Filename:=SavePath & TimecardFilename, FileFormat:=xlOpenXMLWorkbook ' 如果工时卡需要保留宏，修改为xlOpenXMLWorkbookMacroEnabled
TimecardRTE0.Close SaveChanges:=False ' 关闭模板副本，原模板不修改

MsgBox "工时卡生成完成，存放路径：" & SavePath & TimecardFilename
End Sub

注意事项 #

• 代码中Tasks绑定的工作表名称需要修改为你实际存放TaskDataBase表格的工作表名称
• 存放生成工时卡的文件夹需要提前创建，否则会保存失败
• 如果工时卡模板本身带有宏代码，需要将保存格式修改为xlOpenXMLWorkbookMacroEnabled，文件后缀改为.xlsm

内容的提问来源于stack exchange，提问作者Debs