如何根据条件复制粘贴数据？

Question

我正在尝试创建一个按钮，单击该按钮会从今天的日期列中过滤数据库，然后复制以下整行并将其粘贴到新工作表中。我是编码的新手，请帮助。

Private Sub CommandButton6_Click()

a = Worksheets("Follow Up").Cells(Rows.Count, 1).End(xlUp).Row

For i = 3 To a

    If Worksheets("Follow Up").Cells(i, 15).Value = Date Then

        Worksheets("Follow Up").Rows(i).Copy

        Worksheets("today").Activate

        Worksheets("today").Cells(2, 1).Select

        ActiveSheet.Paste

    End If

Next i

Answer 1

如果今天将其复制到工作表中

代码

Private Sub CommandButton6_Click()

    Dim rngU As Range   ' Union Range
    Dim a As Long       ' Source Last Row
    Dim b As Long       ' Target Last Row
    Dim i As Long       ' Source Row Counter

    ' Source Worksheet
    With Worksheets("Follow Up")
        a = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 3 To a
            If .Cells(i, 15).Value = Date Then
                If Not rngU Is Nothing Then
                    Set rngU = Union(rngU, .Cells(i, 1))
                  Else
                    Set rngU = .Cells(i, 1)
                End If
            End If
         Next
    End With

    ' Target Worksheet
    If Not rngU Is Nothing Then
        With Worksheets("today")
             b = .Cells(.Rows.Count, 1).End(xlUp).Row
             rngU.EntireRow.Copy .Rows(b + 1)
             Set rngU = Nothing
        End With
    End If

End Sub

Answer 2

您可以使用autofilter（请注意，Sub只会查看今天的日期）：

Private Sub CommandButton6_Click()

Dim wsFU As Worksheet
Dim wsTD As Worksheet

Set wsFU = Worksheets("Follow Up")
Set wsTD = Worksheets("today")

Application.DisplayAlerts = False
wsTD.Delete
Application.DisplayAlerts = True

a = wsFU.Cells(Rows.Count, 1).End(xlUp).Row

wsFU.AutoFilterMode = False

ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "today"
Set wsTD = Worksheets("today")

With wsFU.Range("A1:P" & a) 'adjust to end of data columns
    .AutoFilter Field:=15, Criteria1:=Format(Date, "mm/dd/yy") ' adjust to what your date format looks like
    .SpecialCells(xlCellTypeVisible).Copy Destination:=wsTD.Range("A2")
End With

wsFU.AutoFilterMode = False

End Sub