Microsoft Excel

Herbers Excel/VBA-Archiv

gefilterte Zeilen kopieren

Betrifft: gefilterte Zeilen kopieren von: Elmar Bruderhofer
Geschrieben am: 19.08.2020 19:39:45

Hallo Experten,

ich hab aus dem Forum hier das untere Makro bekommen, was schon echt richtig klasse ist.

Nun hab ich eine Frage an die Experten, denn irgendwie bekomme ich nicht hin, dass das Makro auch dann klappt, wenn der Autofilter nicht wie hier ab / in Zeile 1 sondern ab der Zeile 23 filtert.

Wenn der Filter in der Zeile 1 steht, klappt das Makro bestens, aber ich bräuchte es eben erst ab der Zeine 23.

Danke schon mal vorab..


VG aus Bayern

Elmar

Sub FilterBereichKopieren()
    'Makro kopiert die ersten X angezeigten Zeilen in einer gefilterten Liste
    '09.12.2010, NoNet - www.excelei.de
    
    Dim lngLZ As Long, lngAnzahl As Long
    Dim rngF As Range, rngZ As Range
        
    lngAnzahl = 20 'nur die ersten 20 gefilterten Werte (inkl.Überschrift) kopieren
    Set rngF = Intersect(ActiveSheet.AutoFilter.Range, Columns("A:A")).SpecialCells( _
xlCellTypeVisible)
    
    For Each rngZ In rngF
        lngLZ = lngLZ + 1
        If lngLZ > lngAnzahl Then  'Schleife nur bis zur angegebenen Anzahl
            lngLZ = rngZ.Row
            Exit For    'sehr unelegant, in einer FOR...EACH-Schleife jedoch nicht anders lö _
sbar !
        End If
    Next
    
    'Spalten A:J kopieren :
    Intersect(ActiveSheet.AutoFilter.Range.Resize(lngLZ - ActiveSheet.AutoFilter.Range.Row + 1), _
 _
 _
 _
 Columns("A:J")).Copy
    
    'Neues Blatt einfügen und dort die kopierten Daten der gefilterten Liste einfügen :
    Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Bild1"
        ActiveSheet.Paste
    Application.CutCopyMode = False
    
      
    Columns("A:A").ColumnWidth = 13.71
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").ColumnWidth = 32.86
    Columns("H:H").ColumnWidth = 15.43
    Columns("I:I").ColumnWidth = 16.14
    Columns("J:J").ColumnWidth = 15.29
    Rows("1:1").Select
    
    Range("A1:J21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Bilder").Select
    
    Range("A45").Select
    ActiveSheet.Pictures.Paste.Select
    
    Dim objpic As Object
    For Each objpic In ActiveSheet.Pictures
    With objpic.ShapeRange
    .LockAspectRatio = False
    .Height = Application.CentimetersToPoints(9.51)
    .Width = Application.CentimetersToPoints(20.01)
    
    End With
    Next
    
    Sheets("Bild1").Select
    Application.DisplayAlerts = False
  Sheets("Bild1").Delete
  Application.DisplayAlerts = True
        
End Sub

Betrifft: AW: gefilterte Zeilen kopieren
von: fcs
Geschrieben am: 20.08.2020 10:44:16

Hallo Elmar,

ich hab das Makro jetzt mal in einer Test-Datei probiert.

A) die Spaltentitel des Autofilters Stehen in Zeile 1

B) die Spaltentitel des Autofilters stehen in Zeile 23

Ergebnis: In beiden Fällen werden die gleichen Ergebnisse als Bild im Blatt "Bilder" angezeigt.
Hier die entsprechenden Ausschnitte der Tabellenblätter als Grafik bei Autofilter ab Zeile 23.
A) Tabelle mit den gefilterten Daten

B) Ergebnis im Blatt "Bilder"


Das Problem muss also irgendwo anders seine Ursache haben. Was ?????

LG
Franz

Betrifft: AW: gefilterte Zeilen kopieren
von: Elmar Bruderhofer
Geschrieben am: 24.08.2020 14:06:21

Hallo Franz,
danke Dir, dass Du das getestet hast. Ich bekomme es immer noch nicht hin, also geht meine Fehlersuche weiter, oder ich muss mir was ganz anderes überlegen....
Wenn ich was gefunden habe, kann ich mich auch nochmal melden.
Danke nochmals für Deine Mühe und sorry für die späte Rückmeldung.
VG
Elmar

Beiträge aus dem Excel-Forum zum Thema "gefilterte Zeilen kopieren"