Копировать данные с указанной датой из одной книги в другую - PullRequest
0 голосов
/ 26 мая 2020

Я новичок в VBA и мне нужна помощь.

Моя цель - скопировать данные в течение определенного c периода из книги, которая собирает данные каждую минуту и ​​используется многими людьми.

Шаги, выделенные ниже:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...