VBA Excel仅在当前日期存在时选择范围

我正在尝试编译一个代码，从名为Employee的工作簿中的每个工作表中获取数据，并提取列“O”中只有当前日期的数据，但是我在添加criteria字段时遇到问题，我可能只是做得不正确

Sub x()

    Dim NewWB As Excel.Workbook
    Dim ws As Excel.Worksheet
    Dim r As Excel.Range
    Dim r2 As Excel.Range

    Set NewWB = Workbooks.Add

    ThisWorkbook.Sheets(6).Range("B1:O1").Copy NewWB.Sheets(1).Range("A1")

    For Each ws In ThisWorkbook.Worksheets

        If ws.name Like "Employee*" Then

        Set r = ws.Range("B2", ws.Range("O" & ws.UsedRange.Rows.count) Field:=15, Criteria1:=">=" & Date)

        r.Copy

        Set r2 = NewWB.Sheets(1).Range("A" & Rows.count).End(xlUp).Offset(1)

        r2.PasteSpecial Paste:=xlValues
        r2.PasteSpecial Paste:=xlPasteColumnWidths
        r2.PasteSpecial Paste:=xlPasteValues
        r2.PasteSpecial Paste:=xlPasteFormats
        r2.Offset(, 14).Resize(r.Rows.count).Value = ws.name
    End If
Next

End Sub

---

谢谢

看起来您正在尝试使用自动筛选，但我们只能在复制数据之前使用它来组织数据。这里的信息非常有用：。然后我们需要在复制之前将范围设置为新过滤的范围：

Sub x()

Dim NewWB As Excel.Workbook
Dim ws As Excel.Worksheet
Dim r As Excel.Range
Dim r2 As Excel.Range

Set NewWB = Workbooks.Add

'Not sure what this is for or if you need this
ThisWorkbook.Sheets(6).Range("B1:O1").Copy NewWB.Sheets(1).Range("A1")

For Each ws In ThisWorkbook.Worksheets

    If ws.Name Like "Employee*" Then

        ws.AutoFilterMode = False

        Dim filterRange As Excel.Range

        Set filterRange = ws.Range("B2", ws.Range("O" & ws.UsedRange.Rows.Count))

        filterRange.AutoFilter
        filterRange.AutoFilter _
            Field:=14, _
            Criteria1:=">=" & Date

        'Set to the cells that aren't filtered out
        Set r = filterRange.Rows.SpecialCells(xlCellTypeVisible) 

        r.Copy

        Set r2 = NewWB.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1)

        r2.PasteSpecial Paste:=xlValues
        r2.PasteSpecial Paste:=xlPasteColumnWidths
        r2.PasteSpecial Paste:=xlPasteValues
        r2.PasteSpecial Paste:=xlPasteFormats
        r2.Offset(, 14).Resize(r.Rows.Count).Value = ws.Name

        ws.AutoFilterMode = False 'remove filter after you're done

    End If
Next

End Sub

编辑：我们走错了方向。自动筛选不返回范围，它将自动筛选设置为范围。很抱歉让你误入歧途，我唯一见过的“字段：”和“标准1:”用于自动筛选。但我看到了它是如何在这里使用的，并修改了我的帖子，使之符合我的想法

---

编辑：找到错误。筛选范围内没有15个字段。才14岁。为答案添加了完整的子项。

我得到了一个编译错误：在字段=15的行上应为：表达式，我尝试删除代码分隔符，并将该字段放在.AutoFilter旁边，但也不起作用。@Lilly让我知道我对该答案所做的编辑是否起作用。看来你写的东西可以起作用，但我遇到的问题是，在您提供的代码中设置了筛选部分是为了添加新工作簿，因此发生了一个错误，因为数据尚未复制。@Lilly我们试图将筛选条件设置为不在筛选范围内的列时出错了（只有14列，因为我们跳过了第一列）。对答案的新编辑应该对您有效。这确实起到了作用，但现在粘贴时，它将粘贴到以前粘贴的数据上。它不会粘贴到下一个可用行上。