Excel vba日期过滤器并复制到新工作表

我想使用VBA根据以下条件过滤数据：日期-3到日期+3，然后复制到新工作表。如果没有结果返回，它也会将空白复制到新的工作表，但不只是将今天的数据复制到新工作表中的成功，请告诉我如何解决这个问题？多谢各位

这是我的密码：

Private Sub CommandButton13_Click()
Dim d As Date
Dim wSheetStart As Worksheet
Set wSheetStart = ThisWorkbook.Sheets("ATA")

Sheets.Add.Name = "New report"
wSheetStart.Activate
wSheetStart.AutoFilterMode = False

For d = DateSerial(Year(Now - 3), Month(Now - 3), Day(Now - 3)) To DateSerial(Year(Now + 3), Month(Now + 3), Day(Now + 3))
ActiveSheet.Range("A6:AC6").AutoFilter Field:=1, Criteria1:=">=" & d, Operator:=xlAnd, Criteria2:="<=" & d

Set rngVisible = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
If rngVisible.Rows.Count > 1 Or rngVisible.Areas.Count > 1 Then
Worksheets("ATA").Range("A7").Select
Worksheets("ATA").Range(Selection, Selection.End(xlToRight)).Select
Worksheets("ATA").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
 Worksheets("New report").Range("A1").PasteSpecial
 Else
Worksheets("ATA").Range("A333:AC333").Select
 Selection.Copy
 Sheets("New report").Activate

 Sheets("New report").Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial
End If

Next d
End Sub

Private子命令按钮13_单击（）
日期
将wSheetStart设置为工作表
设置wSheetStart=thiswoolk.Sheets（“ATA”）
Sheets.Add.Name=“新建报告”
wSheetStart.Activate
wSheetStart.AutoFilterMode=False
对于d=日期序列（年（现在为-3）、月（现在为-3）、日（现在为-3））到日期序列（年（现在为+3）、月（现在为+3）、日（现在为+3））
ActiveSheet.Range（“A6:AC6”）.AutoFilter字段：=1，Criteria1:=“>=”&d，运算符：=xlAnd，Criteria2:=”根据您的描述，我认为您不需要遍历日期范围。相反，声明两个日期变量，它们可能包含开始日期和结束日期，并相应地过滤数据

此外，除非确实需要，否则避免选择范围和图纸

Private Sub CommandButton13_Click()
Dim dStart As Date, dEnd As Date
Dim wSheetStart As Worksheet, wsDest As Worksheet
Dim rngVisible As Range

Application.ScreenUpdating = False

Set wSheetStart = ThisWorkbook.Sheets("ATA")

dStart = DateAdd("d", -3, Date)
dEnd = DateAdd("d", 3, Date)

On Error Resume Next
Set wsDest = Sheets("New report")

If wsDest Is Nothing Then Sheets.Add.Name = "New report"

wSheetStart.AutoFilterMode = False

With wSheetStart
    .Range("A6:AC6").AutoFilter field:=1, Criteria1:=">=" & dStart, Operator:=xlAnd, Criteria2:="<=" & dEnd
    Set rngVisible = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    If rngVisible.Rows.Count > 1 Or rngVisible.Areas.Count > 1 Then
        .Range("A7", .Range("A7").End(xlToRight).End(xlDown)).Copy wsDest.Range("A1")
    Else
        .Range("A333:AC333").Copy wsDest.Range("A" & Rows.Count).End(3)(2)
    End If
End With
wSheetStart.AutoFilterMode = False
wSheetStart.Activate
Application.ScreenUpdating = True
End Sub

请尝试一下，如果需要，请调整一下

Private Sub CommandButton13_Click()
Dim dStart As Date, dEnd As Date
Dim wSheetStart As Worksheet, wsDest As Worksheet
Dim rngVisible As Range

Application.ScreenUpdating = False

Set wSheetStart = ThisWorkbook.Sheets("ATA")

dStart = DateAdd("d", -3, Date)
dEnd = DateAdd("d", 3, Date)

On Error Resume Next
Set wsDest = Sheets("New report")

If wsDest Is Nothing Then Sheets.Add.Name = "New report"

wSheetStart.AutoFilterMode = False

With wSheetStart
    .Range("A6:AC6").AutoFilter field:=1, Criteria1:=">=" & dStart, Operator:=xlAnd, Criteria2:="<=" & dEnd
    Set rngVisible = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    If rngVisible.Rows.Count > 1 Or rngVisible.Areas.Count > 1 Then
        .Range("A7", .Range("A7").End(xlToRight).End(xlDown)).Copy wsDest.Range("A1")
    Else
        .Range("A333:AC333").Copy wsDest.Range("A" & Rows.Count).End(3)(2)
    End If
End With
wSheetStart.AutoFilterMode = False
wSheetStart.Activate
Application.ScreenUpdating = True
End Sub

Private子命令按钮13_单击（）
Dim dStart As Date，dEnd As Date
将wSheetStart设置为工作表，wsDest设置为工作表
变暗RNG可视范围
Application.ScreenUpdating=False
设置wSheetStart=thiswoolk.Sheets（“ATA”）
dStart=DateAdd（“d”，-3，日期）
dEnd=日期添加（“d”，3，日期）
出错时继续下一步
设置wsDest=工作表（“新报告”）
如果wsDest为Nothing，则Sheets.Add.Name=“新建报告”
wSheetStart.AutoFilterMode=False
使用wSheetStart
.Range（“A6:AC6”）。自动筛选字段：=1，标准1:=“>=”&dStart，运算符：=xlAnd，标准2:=“欢迎使用！这是一个程序员编写自己的代码并在试图自己解决某个特定问题后与之共享问题的网站。如果，之后，你有一个特定的问题，请分享你的帖子和一些背景信息。一些好的阅读材料可以帮助您开始：“”以及提示和。您是想在
DateAdd
行中包含
Date+3
？看起来你应该用一个（DateAdd）或另一个（Date+/-3）@dbmitch谢谢你的捕获。我忘了把它取下来。：）回答很好-您还应该让OP知道您已经替换了
。请选择带有更好代码的
行再次感谢！我懒得加上那个解释当看到OP的代码时，我想知道从A7向下复制数据的行的效果——这不是复制了所有的单元格而不仅仅是可见的单元格吗？复制实际的
rngVisible
不是更好吗？我还没有测试，只是想知道？