Я новичок в 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