Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.06.2024 19:56:24
17.06.2024 19:39:46
Anzeige
Archiv - Navigation
1256to1260
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Gefilterte Daten
kurt
Hallo zusammen,
ich habe dieses Makro gefunden (Forum), ich möchte nur die gefilterten Daten
kopieren und in die Tabelle "Gefiltert" einfügen und zwar ab Zeile 4 !
Leider kommt Fehlermeldung:
Bei einer Makierung von nicht angrenden Zellen, ist diese Aktion nicht durchführbar.
Ich habe nur verschiedene Spalten verkleinert.
Sub SortKopie()
Dim rg1 As Range, rg2 As Range, rg3 As Range, rg4 As Range
If IstBerechtigtSchutz Then
Sheets("Gefilterte").Visible = True
Sheets("Gefilterte").Select
Range("A4").Select
ActiveSheet.Unprotect (getStrPasswort)
Sheets("L").Select
ActiveSheet.Unprotect (getStrPasswort)
If Not ActiveSheet.AutoFilterMode Then         'muß rein sonst werden nicht alle Daten  _
kopiert
Range("A3:AY3").AutoFilter
End If
'alle sichtbaren Zellen im Filterbereich
'leider gehören dazu auch die Spaltenüberschriften
Set rg1 = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
'Überschriftenzeile ermitteln
Set rg2 = rg1.Rows(1)
'alle Spaltenüberschriften rausselektieren
For Each rg3 In rg1
If Application.Intersect(rg3, rg2) Is Nothing Then
'alle Zellen zu einem neuen Bereich (rg4) zusammenfassen, _
die sich nicht in der Überschriftenzeile befinden
If rg4 Is Nothing Then
Set rg4 = rg3
Else
Set rg4 = Union(rg4, rg3)
End If
End If
Next rg3
''gefilterte Zellen selektieren
rg4.Select
rg4.Copy
Sheets("Gefilterte").Select
Range("A4").Select
ActiveSheet.Paste
Range("A2").Select
Application.CutCopyMode = False     'kopieren zurücksetzen
'alle Objektvariablen deaktivieren
Set rg1 = Nothing
Set rg2 = Nothing
Set rg3 = Nothing
Set rg4 = Nothing
Sheets("L").Select
Range("A2").Select
Else
MsgBox "Sie haben für diese Aktion keine Berechtigung !               " & Chr(13) _
& Chr(13), 48, " Hinweis !"
End If
'  Application.EnableEvents = True
End Sub
mfg Kurt P
AW: Gefilterte Daten
15.04.2012 14:15:14
Matthias
Hallo Kurt,
bei diesem Makro startest du im activen Sheet!
Sub AutofilterErgebnisKopieren()
'Kopiert den sichtbaren Teile einer per Autofilter gefilterten Tabelle
'ohne Überschriften in ein anderes Tabellenblatt, hier sheet(3)
ActiveSheet.AutoFilter.Range.Offset(1). _
Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sheets(3).Cells(Sheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) 'Sheets(ändern)
End Sub
so ? kommt in ein Modul
Gruß Matthias
AW: Gefilterte Daten
15.04.2012 14:26:27
kurt
Hallo Matthias,
es kommt Fehler Laufzeitfehler 9
Index außerhalb des gültigen Bereichs
Sub AutofilterErgebnisKopieren()
'Kopiert den sichtbaren Teile einer per Autofilter gefilterten Tabelle
'ohne Überschriften in ein anderes Tabellenblatt, hier sheet(3)
ActiveSheet.AutoFilter.Range.Offset(1). _
Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sheets(24).Cells(Sheets(24).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) 'Sheets(ändern)
End Sub

Mein Name der Tabelle wo reinkopiert wird ist Tabelle 24 oder auch Gefilterte
mfg kurt p
Anzeige
Du musst schon richtige Angaben,...
15.04.2012 14:41:30
Matthias
Hallo kurt ,
...machen, Sheets(X) X = Reihenfolge deiner Tabellenblätter am unteren Rand deiner Tabelle.
Beispiel : tabelle1, tabelle2, gefilterte, tabelle4 => Sheets(3) da an 3ter Stelle.
Sub AutofilterErgebnisKopieren()
'Kopiert den sichtbaren Teile einer per Autofilter gefilterten Tabelle
'ohne Überschriften in ein anderes Tabellenblatt, hier sheet(3)
ActiveSheet.AutoFilter.Range.Offset(1). _
Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sheets(X).Cells(Sheets(X).Cells(Rows.Count, 1).End(xlUp).Row + 3, 1) 'Sheets( _
ReihenfolgeNr)
End Sub
jetzt ab Zeile 4 in gefilterte einfügen Row +3
Gruß matthias
Anzeige
auch die Formel etc.
15.04.2012 14:30:39
kurt
Hallo Matthias,
es sollen auch die Formel kopiert werden.
gruß kurt p
das weis ich nicht,lasse offen...!!
15.04.2012 14:50:43
Matthias
ich bin noch VBA Anfänger, leider weis ich nicht was ich da tun muss um die Formeln mit zu kopieren.
Copy kopiert doch eigentlich alles, der Unterschied ist doch nacher das "Past"spezial mit seinen Eigenschaften
Gruß Matthias
STAUS OFFEN vergessen! -Danke owT.
15.04.2012 15:15:43
Matthias
AW: STAUS OFFEN vergessen! -Danke owT.
15.04.2012 15:29:33
Hajo_Zi
Hallo Matthias,
Dein Code kopiert auch Formel, da Du nicht mit PasteSpezial gearbeitet hast.
Gruß Hajo
das geht doch händisch viel einfacher
15.04.2012 14:17:31
Matthias
Hallo
Einfach Filter setzen, dann die Daten markieren, kopieren
und in der Zieltabelle in die entsprechende Spalte in Zeile(4) einfügen.
Das wars doch auch schon.
Ich vermute mal Dein Makroproblem basiert auf verbundene Zellen
Gruß Matthias
Anzeige
AW: das geht doch händisch viel einfacher
15.04.2012 14:27:34
kurt
Hallo,
ich habe nur in der Zeile 2 verbundene Zellen,
gruß kurt p
AW: Gefilterte Daten
15.04.2012 14:17:54
Hajo_Zi
Hallo Kurt,
warum soviele Zeile für das kopieren?
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Copy Range("A15")

Sorry Hajo, habe es verpeilt...
15.04.2012 17:51:16
kurt
Sorry Hajo, habe es verpeilt...
15.04.2012 17:51:18
kurt
AW: Sorry Hajo, habe es verpeilt...
15.04.2012 18:04:20
Hajo_Zi
welches der 5 Worte sollen wir jetzt als Grund für offen ansehen?
Gruß Hajo
AW: Sorry Hajo, habe es verpeilt...
15.04.2012 18:07:08
kurt
Sorry Hajo,
habe gerade nochmal geschrieben was nicht klappt, es fehlen die Formeln.
ActiveSheet.AutoFilter.Range.Offset(1). _
Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sheets(3).Cells(Sheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) 'Sheets(ändern)
gru kurt p
Anzeige
kleine Musterdatei,....
15.04.2012 19:11:56
Matthias
Hallo Kurt,
schau dir bitte mal die Musterdatei an: https://www.herber.de/bbs/user/79809.xlsm ,
dort ist das Makro von Matthias L. eingefügt.
das kopierte wird dann in der "Gefiltert" Tabelle an Range "A4" eingefügt.
solltest dort weitere filterungen haben wollen , muss dieser Code erweitert werden.
Gruß Matthias (ohne L.)
Danke an alle Hajo, mMattihas mit L u. ohne L -)
15.04.2012 21:38:37
kurt
Guten Abend Matthias ohne L,
war gerade in Bonn deshalb antworte ich jetzt erst.
Das klappt soweit alles gut.
Allerdings habe ich einige Spalten jetzt rote Farbe, werde das aber mal raussuchen warum
und das Format hatte sich in 000,00 geändert anstatt 000,
Tausend Dank,
mfg kurt p
wenn ich nicht zurecht komme, melde ich mich halt.
Anzeige
Gefilterte Daten mit Formel kopieren
15.04.2012 15:18:47
Matthias
Hallo
Eigentlich hättest Du doch nur Hajos Bsp. anpassen müssen
Warum hast Du ihm denn nicht geantwortet, wenn er Dir schon einen Vorschlag macht ?
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Worksheets("Gefiltert").Range("A4").PasteSpecial Paste:=xlFormulas
Application.CutCopyMode = False
Gruß Matthias
Danke - ich hab wieder mal was gelernt owT.
15.04.2012 15:30:26
Matthias
leider Fehlermeldung
15.04.2012 17:50:09
kurt
Hallo Matthias,
da habe etwas verpeilt...
Bei deinem Beispiel kommt Fehlermeldung:
Laufzeitfehler 1004
Bei einer Makierung von nicht angrenzenden Zellen ist
die Ausführung diesen Befehls nicht möglich.
gruß kurt p
Anzeige
So kopiert aber ohne formel
15.04.2012 18:02:22
kurt
Hallo Matthias,
so funktioniert es allerdings ohne Formel.
ActiveSheet.AutoFilter.Range.Offset(1). _
Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy _
Sheets(3).Cells(Sheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) 'Sheets(ändern)
gruß
kurt p
fertige Lösung..habe selbst noch was probiert
15.04.2012 19:59:24
Matthias

Sub AutofilterErgebnisKopieren()
'Kopiert gefilterte Daten nach Tabellenblatt"Gefiltert"
'fügt die Werte und Formel ab Zeile A4
ActiveSheet.AutoFilter.Range.Offset(1). _
Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).copy
With Worksheets("Gefiltert")
Dim letzteZ As Long
letzteZ = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Cells(letzteZ, 1).PasteSpecial Paste:=xlFormulas
End With
Application.CutCopyMode = False
Sheets("Tabelle1").Activate
End Sub
Mustermappe: https://www.herber.de/bbs/user/79811.xlsm
Gruß Matthias
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige