Question

我在Excel中有一张表格，如下所示

1   apple   8/1/2013    8/2/2013    99373        11
2   apple   8/13/2013   8/3/2013    2626282    2121
3   berry   8/12/2013   8/4/2013    1289127     123
4   berry   8/15/2013   8/5/2013    12712671   1234
5   cherry  8/19/2013   8/6/2013    127127     3354
    apple   9/1/2013    9/5/2013    123456      200
    apple   9/2/2013    9/6/2013    246810      300
    berry   9/3/2013    9/7/2013    3691215     400
    berry   9/4/2013    9/8/2013    48121620    500
    cherry  9/5/2013    9/9/2013    510152025   600
    cherry  9/6/2013    9/10/2013   612182430   700
    apple   9/7/2013    9/11/2013   714212835   800
    berry   9/8/2013    9/12/2013   816243240   900
    berry   9/9/2013    9/13/2013   918273645   1000
    apple   9/10/2013   9/14/2013   10203040    1100

我试图获得excel复制上个月（在这种情况下为9/1/13 - 9/30/13）苹果，浆果或樱桃的每一行，并将它们放在相应的表格中。表名是苹果，浆果和樱桃。然后它插入一行并将行添加到带有数据的最后一行之后的行。我还需要它在列a中的系列中生成下一个数字，然后将其复制到相应的工作表。因此第6行的第a列中的数字为6。

我尝试了一些VBA代码，但是我在查找所有工作表名称而不仅仅是“苹果”时遇到了一些麻烦。此外，我无法找到数据的最后一行。请参阅下面的代码：

Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = 15
pasteRowIndex = 1

For r = 1 To endRow

    If Cells(r, Columns("B").Column).Value = "apple" Then


        Rows(r).Select
        Selection.Copy


        Sheets("apple").Select
        Rows(pasteRowIndex).Select
        ActiveSheet.Paste


        pasteRowIndex = pasteRowIndex + 1



        Sheets("Sheet1").Select
    End If
Next r
End Sub

Answer 1

我修改了您的代码，而不是逐行复制行，它会自动过滤，一次复制整个适用范围。此外，这假定任何未命名为“Sheet1”的工作表将用作搜索和复制条件。

Application.CutCopyMode = False

Dim r As Long, c As Long
Dim ws As Worksheet
Dim sFruit As String
Dim wsRow as Long

Worksheets("Sheet1").Activate
r = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'find last row
c = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column 'find last column
Range("A1").AutoFilter
Range("C1:C" & r).AutoFilter Field:=3, Criteria2:=Array(1, "9/30/2013") 'filters for month of Sep'13

For Each ws In Worksheets
    If ws.Name <> "Sheet1" Then
        '*edited to accommodate pre-existing data
        ws.Activate '*activate sheet so you can use Cells() with it
        wsRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1 '*find first usable row in ws
        sFruit = ws.Name 'criteria to look for
        Worksheets("Sheet1").Activate 'bring focus back to main sheet
        Range("B1:B" & r).AutoFilter Field:=2, Criteria1:=sFruit
        Range(Cells(2, 1), Cells(r, c)).SpecialCells(xlCellTypeVisible).Copy ws.Range("A" & wsRow)
    End If
Next ws

Range("A1").AutoFilter

Application.CutCopyMode = True

您可以添加按日期过滤的功能。我建议使用自动过滤器录制自己，这样你就可以了解如何修改代码。

如果符合条件，则使用宏将行复制到另一个工作表中

1 个答案: