AW: Copy mit Kriterien
19.10.2021 17:13:21
Daniel
Hi
hier werden die zu kopierenden Zellen nicht sofort und damit einzeln kopiert, sondern die Zellen werden zunächst mal in einer Range-Variable gesammelt um dann alle zusammen in einem einzigen Schritt kopieren zu können.
ist im Prinzip wie wenn du in einem Haus die Fenster erneuern lässt.
wenn du das für jedes Fenster einzeln machen lässt, muss der Handwerker für jedes Fenster extra anfahren und du bekommst auch für jedes Fenster eine eigene Rechnung. Das dauert dann länger, als wenn du dem Handwerker einen Auftrag über alle Fenster gibst und dieser dann nur einmal anfahren muss und dabei schon alle neuen Fenster dabei hat und dir auch nur eine Rechnung schreiben muss. Es spart in Excel internen Aufwand, wenn man nicht jede Zelle einzeln bearbeitet, sondern möglichst wendige, dafür große Zelleberiche in einem Schritt.
ich hätte das ganze ohne Schleife über die Zellen gemacht.
zunächst hätte ich die Liste nach Spalte B sortiert, und dann für den jeweiligen Bereich die erste und letzte Zelle ermittelt und dann alle Zellen dazwischen als lückenlosen Block kopiert:
dim Zelle1 as Range
dim Zelle2 as range
With Sheets("Test")
.usedrange.Sort key1:=.cells(1, 2), order1:=xlascending, header:=xlno
set Zelle1 = .Columns(2).Find(what:="5", lookat:=xlwhole, lookin:=xlvalues, searchdirection:=xlnext)
set Zelle2 = .Columns(2).Find(what:="5", lookat:=xlwhole, , lookin:=xlvalues, searchdirection:=xlprevious)
Range(Zelle1, Zelle2).offset(0, -1).Resize(, 9).Copy Worksheets("5").Cells(1, 1)
set Zelle1 = .Columns(2).Find(what:="6", lookat:=xlwhole, lookin:=xlvalues, searchdirection:=xlnext)
set Zelle2 = .Columns(2).Find(what:="6", lookat:=xlwhole, , lookin:=xlvalues, searchdirection:=xlprevious)
Range(Zelle1, Zelle2).offset(0, -1).Resize(, 9).Copy Worksheets("6").Cells(1, 1)
End with
wenn, dann kann man hier die Schleife über den Suchbegriff laufen lassen, so dass man den ganzen Vorgang nur einmal programmieren und nicht wiederholen muss
dim Zelle1 as range
dim Zelle2 as range
dim X
With Sheets("Test")
.usedrange.Sort key1:=.cells(1, 2), order1:=xlascending, header:=xlno
for each X in Array("5", "6")
set Zelle1 = .Columns(2).Find(what:=X, lookat:=xlwhole, lookin:=xlvalues, searchdirection:=xlnext)
set Zelle2 = .Columns(2).Find(what:=X, lookat:=xlwhole, , lookin:=xlvalues, searchdirection:=xlprevious)
Range(Zelle1, Zelle2).offset(0, -1).Resize(, 9).Copy Worksheets(X).Cells(1, 1)
Next
End with
Gruß Daniel