Schleifen durch Zeilen, um eins basierend auf Bedingung

Question

zu kopieren Ich habe Code, der durch mein Arbeitsblatt durchlaufen wird, aber es führt alle Zeilen und nicht nur die Zeilen nach meinen Kriterien kopiert. Wie sollte ich nur die Zeile kopieren, die ich möchte?

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

Ein paar Dinge:

• Nur die Arbeitsmappe öffnen einmal, wird dies die bedeutendste Leistungssteigerung
• Verweise auf Arbeitsmappen/Arbeitsblätter erstellen, anstatt ActiveSheet/ActiveWorkbook
mit
• Einrückung ist so wichtig. Es macht Code so viel besser lesbar und es ist der erste Schritt, um Ihre eigenen Fehler bei der Suche nach

---

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