excel - 将具有指定日期的数据从一个工作簿复制到另一个工作簿

Question

我是 VBA 新手，需要一些帮助。

我的目标是从每分钟收集数据并被许多人使用的工作簿中复制特定时期内的数据。

下面突出显示的步骤：

1-开源 2-使用指定的开始和结束日期 3-删除表格上的任何现有过滤器 >>>这很重要，因为很多人使用它，我希望它没有过滤器 4-过滤开始/结束日期 5-过滤按升序排列 6-复制所有数据，包括标题 7-将所有数据粘贴到目标位置 8-从源中删除所有过滤器并关闭保存

下面是我的代码：谢谢

Sub Copydated()

'Disabling screen updates
Application.ScreenUpdating = False

'Declaring two variables of Date data type
Dim StartDate, EndDate As Date
Dim wbd, wbs As Workbook
Dim shd, shs, shi As Worksheet

Set wbd = ThisWorkbook
Set shd = wbd.Sheets("Data Dump")
Set shi = wbd.Sheets("Instruction")
Set wbs = Workbooks.Open("path")

'Initializing the Date variables with start/end date
StartDate = shi.Range("B3").Value
EndDate = shi.Range("D3").Value


'Activating the worksheet object and filter
'Filter the data based on date range between starting date and end date

wbs.Activate
    Rows("1:1").Select
    wbs.Sheets("Sheet1").ListObjects("Table_lebsqlprodmo.advics.local_CaliperData_PerformTestData") _
    .Sort.SortFields.Clear
    wbs.Sheets("Sheet1").ShowAllData
    wbs.Sheets("Sheet1").ListObjects("Table_lebsqlprodmo.advics.local_CaliperData_PerformTestData") _
    .Range.AutoFilter Field:=1, Criteria1:= _
        ">=" & StartDate, Operator:=xlAnd, Criteria2:="<=" & EndDate
    wbs.Sheets("Sheet1").ListObjects( _
        "Table_lebsqlprodmo.advics.local_CaliperData_PerformTestData").Sort.SortFields. _
        Add Key:=Range("Table_lebsqlprodmo.advics.local_CaliperData_PerformTestData[[#All],[DataTime]]") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Sheet1").ListObjects( _
        "Table_lebsqlprodmo.advics.local_CaliperData_PerformTestData").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Select all data and copy
        Range("A1").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

'Paste data into desti
shd.Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

'Remove filter from source and close
wbs.Activate
    Selection.AutoFilter
wbs.Close savechanges:=False


End Sub

标签： excelvba