Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
880to884
880to884
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Filterergebnis per VBA kopieren

Forumthread: Filterergebnis per VBA kopieren

Filterergebnis per VBA kopieren
27.06.2007 11:10:44
Melanie
Hallo Excel-Profis,
ich habe folgende Frage, ich würde gerne per VBA das Ergebnis meines Autofilters ohne Überschrift (!) in ein anderes Tabelleblatt kopieren. Konkret heißt das, ich filtere nach "neu" und will dann alle Zeilen in denen neu in der Spalte A steht in ein anderes Tabellenblatt kopieren. Wie mache ich das?
Grüße, Melanie

Anzeige

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Filterergebnis per VBA kopieren
27.06.2007 11:18:00
Chaos
Servus Melanie,
wenn ich's richtig verstanden habe, dann z.B.: so.
erst filtern, dann Makro

Sub neu()
Dim t As Byte
Dim z As Range, b As Range
t = Worksheets("DeineQuelle").Range("A65536").End(xlUp).Offset(0, 0).Row
Set b = Worksheets("Stornos Gesamt").Range("A2:A" & t)
Application.ScreenUpdating = False
For Each z In b
If z.Value = "neu" Then
z.EntireRow.Copy
End If
Worksheets("Ziel").Activate
Worksheets("Ziel").Range("A65536").End(xlUp).Offset(1, 0).Insert
Next z
Application.ScreenUpdating = True
End Sub


Gruß
Chaos

Anzeige
AW: Filterergebnis per VBA kopieren
27.06.2007 11:19:00
Chaos
Servus Melanie,
sorry, Schreibfehler
wenn ich's richtig verstanden habe, dann z.B.: so.
erst filtern, dann Makro

Sub neu()
Dim t As Byte
Dim z As Range, b As Range
t = Worksheets("DeineQuelle").Range("A65536").End(xlUp).Offset(0, 0).Row
Set b = Worksheets("DeineQuelle").Range("A2:A" & t)
Application.ScreenUpdating = False
For Each z In b
If z.Value = "neu" Then
z.EntireRow.Copy
End If
Worksheets("Ziel").Activate
Worksheets("Ziel").Range("A65536").End(xlUp).Offset(1, 0).Insert
Next z
Application.ScreenUpdating = True
End Sub


Gruß
Chaos

Anzeige
AW: Filterergebnis per VBA kopieren
27.06.2007 11:26:35
Melanie
Hi, erst mal Danke, aber ich bekomm leider nen Fehler -> Überlauf
So sieht der Code mit meinen Variablen aus: 

Sub neu()
Dim t As Byte
Dim z As Range, b As Range
t = Worksheets("ARTIKEL03").Range("A65536").End(xlUp).Offset(0, 0).Row
Set b = Worksheets("ARTIKEL03").Range("A2:A" & t)
Application.ScreenUpdating = False
For Each z In b
If z.Value = "neu" Then
z.EntireRow.Copy
End If
Worksheets("Tabelle1").Activate
Worksheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0).Insert
Next z
Application.ScreenUpdating = True
End Sub


Grüße...

Anzeige
AW: Filterergebnis per VBA kopieren
27.06.2007 11:33:07
Chaos
Hm,
sind wohl ziemlich viele. Kannst du mal die Datei posten?
Kann so jetzt nichts dazu sagen.
Gruß
Chaos

AW: Filterergebnis per VBA kopieren
27.06.2007 11:49:00
Melanie
Hi,
so sieht die Datei aus:
https://www.herber.de/bbs/user/43625.xls
Jetzt soll das Filterergebnis "neu" aus Tabelle1 in Tabelle2 gestellt werden, allerdings ohne Überschrift.

Anzeige
AW: Filterergebnis per VBA kopieren
27.06.2007 11:50:00
Melanie
Ober brauchst Du zwingend das Original?

AW: Filterergebnis per VBA kopieren
27.06.2007 11:55:00
Chaos
Hallo Melanie,
also das Original wäre natürlich besser, aber ich habe dir schon einen anderen Code gepostet. Bin mir ziemlich sicher, dass der funktioniert.
Probier's einfach mal aus.
Der Überlauf kommt durch die Vergabe der Variablenart, vorher Byte jetzt Integer für die Laufvariable und die zeile als Long.
Hab's bis 500 Einträge getestet, und hat funktioniert.
Gruß
Chaos

Anzeige
AW: Filterergebnis per VBA kopieren
27.06.2007 11:49:44
Chaos
Servus Melanie,
weitere Variante,

Sub neu1()
Dim t As Integer
Dim zeile As Long
t = Worksheets("Quelle").Range("A65536").End(xlUp).Offset(0, 0).Row
For zeile = 2 To t Step 1
If Worksheets("Quelle").Cells(zeile, 1).Value = "neu" Then
Worksheets("Quelle").Cells(zeile, 1).EntireRow.Copy Destination:=Sheets("Ziel"). _
Range("A65536").End(xlUp).Offset(1, 0)
End If
Next zeile
End Sub


Probiers mal so aus. Müsste jetzt eigentlich klappen.
Gruß
Chaos

Anzeige
AW: Filterergebnis per VBA kopieren
27.06.2007 11:54:50
Melanie
Ganz großes Kino! Soll heißen funktioniert so weit. Wie sag ich ihm jetzt, dass er an die unterste freie Zeile im Blatt "Ziel" springt und ab da einfügt?

AW: Filterergebnis per VBA kopieren
27.06.2007 11:59:00
Chaos
Servus,
müsste das Makro eigentlich eh schon machen, oder macht es das bei dir nicht?
Sheets("Ziel").Range("A65536").End(xlUp).Offset(1, 0) = ' die erste freie Zelle in Spalte A' oder sind bei dir in den anderen Spalten Einträge die weiter runter gehen als in A?
Gruß
Chaos

Anzeige
AW: Filterergebnis per VBA kopieren
27.06.2007 12:48:00
Chaos
Servus Melanie,
falls dem so ist, wie in meiner letzten AW beschrieben, dann so:

Sub neu1()
Dim t As Integer, s As Integer
Dim zeile As Long
t = Worksheets("Tabelle3").Range("A65536").End(xlUp).Offset(0, 0).Row
s = Worksheets("Tabelle2").Cells.SpecialCells(xlLastCell).Row
s = s + 1
For zeile = 2 To t Step 1
If Worksheets("Tabelle3").Cells(zeile, 1).Value = "neu" Then
Worksheets("Tabelle3").Cells(zeile, 1).EntireRow.Copy Destination:=Worksheets(" _
Tabelle2").Range(("A" & s))
s = s + 1
End If
Next zeile
ThisWorkbook.Save
End Sub


Nachteil: wenn du nach dem kopieren was löschst in deiner Zieltabelle, musst du speichern, sonst fügt Excel die Werte nach der letzten (also gelöschten Gruppe von Daten) ein.
Gruß
Chaos

Anzeige
AW: Filterergebnis per VBA kopieren
27.06.2007 12:54:13
Renee
Mazwara Melanie,
Würde dieser Code, kopiert in ein Modul, nicht genügen ?
Die beiden ersten Zeilen mit den richtigen Blattnamen versehen.

Sub CopyFilteredSheet()
Const sQuelle = "ARTIKEL03"
Const sZiel = "Tabelle1"
If ActiveSheet.Name = sQuelle Then
ActiveSheet.Cells.Copy Destination:=Sheets(sZiel).Range("A1")
Sheets(sZiel).Rows("1:1").Delete shift:=xlUp
Else
MsgBox "Makro kann nur in Tabelle " & sQuelle & " laufen!"
End If
End Sub


Greetz Renee

Anzeige
AW: Filterergebnis per VBA kopieren
27.06.2007 13:05:40
Renee
Hi again,
Ich hab das mit dem Anhängen erst nachher gesehen.
Dann so:

Sub CopyFilteredSheet()
Const sQuelle = "ARTIKEL03"
Const sZiel = "Tabelle1"
Dim dLastRow As Double
If ActiveSheet.Name = sQuelle Then
dLastRow = Sheets(sZiel).Range("A" & Sheets(sZiel).Rows.Count).End(xlUp).Row + 1
ActiveSheet.Cells.Copy Destination:=Sheets(sZiel).Range("A" & dLastRow)
Sheets(sZiel).Rows(dLastRow & ":" & dLastRow).Delete shift:=xlUp
Else
MsgBox "Makro kann nur in Tabelle " & sQuelle & " laufen!"
End If
End Sub


Rgds Renee

Anzeige
Danke euch beiden!
27.06.2007 16:24:40
Melanie
Funzt!
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige