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

我在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行将有第6列在a列。

我已经尝试了一些VBA代码，但我有一些麻烦，使其dynamicsearch所有表名称，而不是只是“苹果”。 另外我无法find数据的最后一行。 请看下面我的代码：

 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

我修改了你的代码，而不是复制行1，它自动过滤，一次复制整个适用的范围。 此外，这假定任何未命名为“Sheet1”的工作表将被用作search和复制标准。

 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 

您可以添加function按date过滤。 我build议使用自动filter录制自己，这样就可以了解如何修改代码。