在日期之间查找数据并将它们复制到新工作簿

时间:2018-03-15 20:30:29

标签: excel vba excel-vba

我正在尝试为我为工作创建的机器停机跟踪器创建报告功能。我有一个userform,询问机器名称,以及他们想要从中获取数据的日期范围。我希望这能打开存储数据的工作簿,捕获他们想要的数据并将其复制到新的工作簿。

在这里搜索了一段时间之后,我能够将自动过滤器功能放在一起,但是我无法在新工作表上显示任何数据。我认为它可能与日期有关,但我似乎无法弄明白。这是我的代码:

Public Sub cmdSubmit_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim copyFrom As Range
Dim lRow As Long
Dim startDate As Date, endDate As Date

Set wb1 = Workbooks.Open("FILEPATH")


'~~> Checks to see what sheet the data should be copied from based on the combo box entry.
If Me.cmboWorkCenter.Value = "Machine1" Then
    Set ws1 = wb1.Sheets("Machine1")
ElseIf Me.cmboWorkCenter.Value = "Machine2" Then
    Set ws1 = wb1.Sheets("Machine2")
ElseIf Me.cmboWorkCenter.Value = "Machine3" Then
    Set ws1 = wb1.Sheets("Machine3")
ElseIf Me.cmboWorkCenter.Value = "Machine4" Then
    Set ws1 = wb1.Sheets("Machine4")
ElseIf Me.cmboWorkCenter.Value = "Machine5" Then
    Set ws1 = wb1.Sheets("Machine5")
ElseIf Me.cmboWorkCenter.Value = "Machine6" Then
    Set ws1 = wb1.Sheets("Machine6")
Else
    MsgBox "ERROR"
    Unload Me
End If

startDate = Me.txtStartTime.Value
endDate = Me.txtEndTime.Value


With ws1

    '~~> Remove any filters
    .AutoFilterMode = False

    lRow = .Range("B" & .Rows.Count).End(xlUp).Row

    With .Range("B1:B" & lRow)
        .AutoFilter Field:=2, Criteria1:=">=" & startDate, Operator:=xlAnd, Criteria2:="<=" & endDate
        Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
    End With

    ''~~> Remove any filters
    .AutoFilterMode = False

End With

'~~> Destination File
Set wb2 = Workbooks.Add
Set ws2 = wb2.Worksheets("Sheet1")

With ws2
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lRow = 1
    End If

    copyFrom.Copy .Rows(lRow)
End With

wb1.Close


End Sub

任何帮助将不胜感激!

1 个答案:

答案 0 :(得分:0)

您只使用B列,特别是.Range(“B1:B”&amp; lRow)。字段不是2它是1,因为.Range中只有一列(“B1:B”&amp; lRow)。

With .Range("B1:B" & lRow)
    .AutoFilter Field:=1, Criteria1:=">=" & startDate, Operator:=xlAnd, Criteria2:="<=" & endDate
    Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
End With