Macro - Bereich kopieren (Aufzeichnung optimieren)

Hi allesamt,
ich bin neu hier und über Google auf das Forum gestossen. Ich habe ein echt "läppisches" Problem, das ich als VBA-Frischling aber nicht geregelt bekomme.
Ich habe eine Tabelle mit 5 Überschriftzeilen und in der 5'en den Autofilter.
Ich habe nun ein Macro aufgezeichnet, das den Autofilter setzt und die gefilterten Einträge kopiert. Diese sollen dann in das Tabellenblatt 2 in den Bereich ab "A6" eingefügt werden.
Soweit funkioniert das Macro einwandfrei, nur aufgrund der Datenmengen zu langsam. (Die obige Prozedur wiederholt sich bestimmt 20x mit insgesamt ca 2500 Zeilen.
Nun möchte ich das Macro einfach optimieren (Entfall der Select's).
Aus
Sheets("Gesamt").Select
Range("a6:ag6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
möchte ich:
Sheets("Gesamt").Range("a6:ag6").Range(Selection, Selection.End(xlDown)).Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
machen. Allerdings erschließt sich mir nirgens, wie ich die selektion "End(xlDown)" hinbekomme, ohne dass ich vorher die select ausführen muss.
Kann mir hierzu jemand die (wahrscheinlich einfache) Lösung sagen?
Ich bedanke mich schon jetzt für das lesen (Ich hoffe es ist verständlich)-
Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Dim LLetzte As Long 'Deine Tabelle2, Name anpassen With Sheets("Tabellenblatt 2") 'Zellen im Ziel leer machen .Range("A6:AG" & Rows.Count).ClearContents 'Daten kopieren wenn letzte größe als Zeile 5 With Sheets("Gesamt") 'Letzte Zeile? LLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row If LLetzte > 5 Then .Range("A6:AG" & LLetzte).Copy End If End With If LLetzte > 5 Then .Range("A6").PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If End With Application.CutCopyMode = False

Dim LLetzte As Long With Sheets("Busch") .Range("A5:AG" & Rows.Count).ClearContents With Sheets("Gesamt") Selection.AutoFilter Field:=2, Criteria1:="Busch" Selection.AutoFilter Field:=29, Criteria1:="M" LLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row If LLetzte > 5 Then .Range("A6:AG" & LLetzte).Copy End If End With If LLetzte > 5 Then .Range("A6").PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If End With Application.CutCopyMode = False

Dim LLetzte As Long With Sheets("Busch") .Range("A5:AG" & Rows.Count).ClearContents With Sheets("Gesamt") 'alten Filter aufheben If .FilterMode Then .ShowAllData End If 'letzte Zeile vor Filter? LLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row 'Eventuell 1 Zelle anpassen hier A5 .Range("A5:AC" & LLetzte).AutoFilter Field:=2, Criteria1:="Busch" .Range("A5:AC" & LLetzte).AutoFilter Field:=29, Criteria1:="M" 'letzte Zeile nach Filter? LLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row If LLetzte > 5 Then .Range("A6:AG" & LLetzte).Copy End If End With If LLetzte > 5 Then .Range("A6").PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If End With Application.CutCopyMode = False

Beliebteste Forumthreads (12 Monate)

Macro - Bereich kopieren (Aufzeichnung optimieren)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread