循环遍历行，根据条件复制一行

我有代码，将循环通过我的工作表，但它执行复制的所有行，而不仅仅是基于我的标准。 我怎样才能得到它只复制我想要的行？

Sub Major2_Paster() Dim LastRow As Integer Dim i As Integer Dim erow As Integer LastRow = Cells(Rows.count, 1).End(xlUp).Row For i = 2 To LastRow If Cells(i, 12) = “MLA” Then range(Cells(i, 1), Cells(i, 21)).Select Selection.Copy Workbooks.Open Filename:="H:\Degrees List\Sorted_Workbooks\MLA Mar-17.xlsx" erow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row ActiveSheet.Cells(erow, 1).Select ActiveSheet.Paste ActiveWorkbook.Save ActiveWorkbook.Close Application.CutCopyMode = False End If Next i End Sub 

Answer 1

几件事情：

• 只打开一次工作簿，这将是最重要的性能提升
• 创build对工作簿/工作表的引用，而不是使用ActiveSheet / ActiveWorkbook
• 缩进如此重要。 它使代码更加可读，这是find自己的错误的第一步

---

  Sub Major2_Paster() Dim LastRow As Integer, i As Integer, erow As Integer Dim destinationWorkbook As Workbook Dim sourceWorksheet As Worksheet, destinationWorksheet As Worksheet Set destinationWorkbook = Workbooks.Open(Filename:="H:\Degrees List\Sorted_Workbooks\MLA Mar-17.xlsx") Set sourceWorksheet = ThisWorkbook.Worksheets("SheetName") Set destinationWorksheet = destinationWorkbook.Worksheets("SheetName") With sourceWorksheet LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With For i = 2 To LastRow If sourceWorksheet.Cells(i, 12).Value = “MLA” Then With destinationWorksheet erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row End With destinationWorksheet.Cells(erow, 1).Resize(1, 21).Value = sourceWorksheet.Range(sourceWorksheet.Cells(i, 1), sourceWorksheet.Cells(i, 21)).Value End If Next i destinationWorkbook.Close SaveChanges:=True Application.CutCopyMode = False End Sub