Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema RefEdit
BildScreenshot zu RefEdit RefEdit-Seite mit Beispielarbeitsmappe aufrufen

Macro - Bereich kopieren (Aufzeichnung optimieren) | Herbers Excel-Forum


Betrifft: Macro - Bereich kopieren (Aufzeichnung optimieren) von: Ralf H.
Geschrieben am: 18.01.2010 11:50:45

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

  

Betrifft: AW: Macro - Bereich kopieren (Aufzeichnung optimieren) von: Tino
Geschrieben am: 18.01.2010 12:22:15

Hallo,
versuche es mal mit diesem Code.

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
Gruß Tino


  

Betrifft: AW: Macro - Bereich kopieren (Aufzeichnung optimieren) von: Ralf H.
Geschrieben am: 18.01.2010 13:21:34

Hi Tino,

erstmal herzlichen dank für Deine Hilfe. Der Code funktioniert, und die Funktionsweise ist mir jetzt klar.

Kannst Du mir hier evtl. mit dem Bereich der Autofilterfunktion helfen. Es wird doch bestimmt genau so einen Ausdruck geben den Autofilter außerhalb der select-Methode anzusprechen, oder?

Hier ist der nun vorhandene Code:

 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



  

Betrifft: AW: Macro - Bereich kopieren (Aufzeichnung optimieren) von: Tino
Geschrieben am: 18.01.2010 13:42:07

Hallo,
müsste so funktionieren.

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
Gruß Tino


  

Betrifft: AW: Macro - Bereich kopieren (Aufzeichnung optimieren) von: Ralf H.
Geschrieben am: 18.01.2010 15:14:21

Tino,... ich danke Dir :-) *SUPER*

Bin jetzt wieder etwas "schlauer"


Beiträge aus den Excel-Beispielen zum Thema "Macro - Bereich kopieren (Aufzeichnung optimieren)"