Ohne weitere Informationen einen Blick läßt haben, was in Bezug auf geändert werden könnte, was Sie geschrieben haben:
1) Ich kann Ihre Variablendeklarationen nicht sehen, also weiß ich nicht wie, und ob Sie Ihre Variablen deklariert haben, noch ob Sie Option Explicit an der Spitze haben. Sie könnten also Fehler wie Type mismatch oder Application-defined or Object-defined error bekommen. Wir wissen es nicht, wie du es nicht sagst.
2) With Range("A1", "K" & lngLastRow) Wir wissen nicht, wie Sie lngLastRow berechnet haben, daher könnte dies aufgrund leerer Zellen in einer Spalte vorzeitig enden. Es bezieht sich auch implizit auf die Activesheet als nicht vollständig als eine Reihe qualifiziert.
3) For Each Account In Accounts Wir kennen die Variablentypen hier nicht, dies könnte zum Beispiel zu einem Typenkonfliktfehler führen. Ich bin mir nicht sicher, ob Accounts, gemeint ist, ein Bereich oder ein benannter Bereich (oder etwas anderes, möglicherweise ein Array) zu sein?
4) .Copy OKSheet.Range("A1") Innerhalb einer Schleife, ohne in irgendeiner Weise zu inkrementieren, überschreiben Sie die Zelle A1 mit dem Inhalt des Filters bei der aktuellen Schleifeniteration. Das bedeutet, dass Sie mit dem letzten Filterkriterium in der Zelle A1 im Zielblatt enden.
5) 1. .AutoFilter Sie löschen den Filter am Ende jeder Schleife, so dass dies redundant sein kann, hängt davon ab, ob der Bereich bereits beim Start der Schleife gefiltert wird.
6) Die folgenden drei Zeilen innerhalb der Schleife, denke ich, sind redundant, da sie eigentlich nichts tun (außer möglicherweise einen Fehler erzeugen), da Ihre Schleife über einen definierten Bereich liegt (Definitiv ein Sammlungsobjekt oder Array , wir hoffen) und Sie werden zum nächsten Element zurückkehren.
Sheets("Summary").Select
Range("A1").Select
Selection.End(xlDown).Offset(2, 0).Select
Und selbst wenn es auf einen bestimmten Bereich wurde Looping nicht, Sie erreichen nicht funktionell nichts mit diesen Schritten, die nicht außerhalb der Schleife mit einer einzigen Zellauswahl durchgeführt werden können.
Die folgende
Sheets("Summary").Select
Als ein .Select vermeiden soll, wenn möglich, könnte werden
Sheets("Summary").Activate
, wenn es nicht etwas in der Zelle ist A2, oder darüber hinaus, dann ist die folgende Zeile hat brachte uns in das Land von Application defined or object defined error, indem wir versuchten, vom Ende der Tabelle zu springen.
Selection.End(xlDown).Offset(2, 0).Select
Selection.End(xlDown) hat uns in die letzte Zeile in dem Blatt aufgenommen und dann wird versucht, zwei weitere Reihen zu kompensieren.
könnten Sie verwenden (und ich vermute, außerhalb der Schleife)
Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "A").End(xlUp).Offset(2, 0).Activate
Vor diesem Hintergrund
Mit Accounts als Range-Objekt-Code aussehen könnte:
Option Explicit
Public Sub TEST()
Dim Accounts As Range 'Variable declarations
Dim Account As Range
Dim wb As Workbook
Dim wsSource As Worksheet
Dim OKSheet As Worksheet
Set wb = ThisWorkbook 'Variable assignments
Set wsSource = wb.Worksheets("Sheet1")
Set OKSheet = wb.Worksheets("Sheet2")
Dim lngLastRow As Long
Dim nextOKRow As Long
lngLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row 'find last row by coming from the bottom of the sheet and finding last used cell in column
Set Accounts = wsSource.Range("A1:A" & lngLastRow) 'define Accounts
For Each Account In Accounts
nextOKRow = OKSheet.Cells(OKSheet.Rows.Count, "A").End(xlUp).Row 'increment where you paste
If nextOKRow > 1 Then nextOKRow = nextOKRow + 1
With wsSource.Range("A1:K" & lngLastRow) 'fully qualify range 'could also have as With wsSource.Range("A1", "K" & lngLastRow)
.AutoFilter 'redundant?
.AutoFilter Field:=1, Criteria1:=Account
.Copy OKSheet.Range("A" & nextOKRow) 'here you were just pasting over the same cell each time
.AutoFilter
End With
' Sheets("Summary").Range("A1").Activate
'Selection.End(xlDown).Offset(2, 0).Select ' off the sheet. 'not actually doing anything as you revisit the next Account range
Next Account
''Potentially uncomment the following two lines
'Sheets("Summary").Activate
'Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "A").End(xlUp).Offset(2, 0).Activate
End Sub
Mit Accounts als benannter Bereich:
Public Sub TEST2()
Dim Account As Range
Dim wb As Workbook
Dim wsSource As Worksheet
Dim OKSheet As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sheet1")
Set OKSheet = wb.Worksheets("Sheet2")
Dim lngLastRow As Long
Dim nextOKRow As Long
lngLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
wsSource.Range("A1:A" & lngLastRow).Name = "Accounts"
For Each Account In wb.Names("Accounts").RefersToRange
nextOKRow = OKSheet.Cells(OKSheet.Rows.Count, "A").End(xlUp).Row
If nextOKRow > 1 Then nextOKRow = nextOKRow + 1
With wsSource.Range("A1:K" & lngLastRow)
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Account
.Copy OKSheet.Range("A" & nextOKRow)
.AutoFilter
End With
Next Account
End Sub
Mit Accounts als Array:
Public Sub TEST3()
Dim Accounts() 'Variable declarations
Dim Account As Variant
Dim wb As Workbook
Dim wsSource As Worksheet
Dim OKSheet As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sheet1")
Set OKSheet = wb.Worksheets("Sheet2")
Dim lngLastRow As Long
Dim nextOKRow As Long
lngLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
Accounts = wsSource.Range("A1:A" & lngLastRow).Value
For Each Account In Accounts
nextOKRow = OKSheet.Cells(OKSheet.Rows.Count, "A").End(xlUp).Row
If nextOKRow > 1 Then nextOKRow = nextOKRow + 1
With wsSource.Range("A1:K" & lngLastRow)
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Account
.Copy OKSheet.Range("A" & nextOKRow)
End With
Next Account
End Sub
]
Und was nicht funktioniert? – QHarr