VBA通过复制和粘贴按日期自动过滤

时间:2019-02-12 14:04:20

标签: excel vba

我有一些代码可以按在单元格中输入的日期进行过滤-过滤器可以工作并选择正确的日期,并按预期保存新文件。

我有两个问题: a)复制和粘贴不会选择标题,而只会选择数据(标题位于第5行,下面的数据) b)宏完成并提供msgBox时,位于第5行的自动过滤器将移至第1行。

Sub RunDailyReport()
'

    ' RunDailyReport Macro


    Dim Path As String
    Dim filename As String
    Dim dDate As Date
    Dim strDate As String
    Dim lDate As Long

    filename = Range("C2").Text

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    If IsDate(Range("C2")) Then
    dDate = Range("C2")
    dDate = DateSerial(Year(dDate), Month(dDate), Day(dDate))
    End If

    lDate = dDate
    Range("A5").AutoFilter
    Range("A5").AutoFilter Field:=1, Criteria1:=">=" & lDate, Operator:=xlAnd, Criteria2:="<" & lDate + 1


    Sheets("Master").Range("A4:J111111").Copy
    Workbooks.Add
    With ActiveSheet.Range("A1")
    .PasteSpecial xlPasteColumnWidths
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
    End With
    Application.DisplayAlerts = False
    Cells.Select
    Cells.EntireColumn.AutoFit
    ActiveWindow.Zoom = 90
    ActiveWindow.Zoom = 80
    Cells.EntireColumn.AutoFit
    Selection.Font.Size = 11
    Columns("I:I").EntireColumn.AutoFit
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With
    ActiveWorkbook.SaveAs ("SAVEPATH\Fee Write Off " & filename & ".xlsx")
    ActiveWorkbook.Close
    Worksheets("Master").ShowAllData
    MsgBox ("Daily Report Saved - check the data has saved correctly before sending onwards")

    Application.EnableEvents = True

    End Sub

0 个答案:

没有答案