Zellenwerte ausgeben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
eine Methode wäre der Spezialfilter:
1. in Zelle J01 ne überschrift reinschreiben
2. nach Tabelle02 wechseln
3. dort in eine freie Zelle die Überschrift von J1 reinschreiben und in die Zelle dadrunterf ">3000"
4. DATEN - FILTER - SPEZIALFILTER klicken
5. dort folgendes Eintragen
- Liste an andere Stelle Filtern aktiviert
- Listenbereich: den Zellbereich Tabelle01!J1:J52
- Kriterienbereich: die beiden Zellen aus Punkt 3
- Kopieren nach: den Zellbereich, wo die Daten hinsollen
und fertig.
die Daten sind aber Statisch, dh. wenn sich die Daten auf Tabelle01 ändern, dann ändern sich die so gefilterten Daten NICHT, dazu müsste der Spezialfilter nochmal aktiviert werden.
fallls du es Dynamisch brauchst (dh Änderungen in Tabelle01 werden sofort in Tabelle02 übernommen), müsstest du eine Formelbasierte Lösung verwenden, da findest du wenn, dann hier was passendes:
http://www.excelformeln.de/formeln.html?gruppe=11
Gruß, Daniel

Ich habe es so verstanden, das Du die komplette Zeile in der in der Spalte J eine Zahl > 3000 steht mit in Tabelle2 nehmen _ willst. Dafür habe ich jetzt mal eine Beispielmappe hochgeladen (wie ich es mir vorstelle)

Hallo
ich hab versucht, deine Wünsche mal umzusetzen
1. es werden nur die Spalten B, E, und H kopiert. beim Einfügen rutschen diese allerdings zusammen, dh sie stehen direkt nebeneinander ohne Zwischenspalten
2. die Daten werden an der Zelle eingefügt, die beim Start es Makros aktiv ist, dh. du musst erst die Zielzelle in Tabelle2 aktvieren und dann das Makro starten (dh. du musst den Startbutton auf das andere Blatt verlegen!)
3. die Bedingugen zum Kopieren habe ich nach deinen Wünschen ergänzt.


Sub Schaltfläche1_BeiKlick()
Dim x As Long, Y As Long
Dim ZielZelle As Range
If ActiveSheet.Name  "Tabelle2" Then
MsgBox "Bitte aktivieren Sie die Zieltabelle und die Zielzelle und starten dann das Makro  _
nocheinmal."
Exit Sub
End If
Set ZielZelle = ActiveCell
Application.ScreenUpdating = 0
Y = 1
With Sheets("Tabelle1")
For x = 2 To 50
If .Cells(x, "J") > 3000 And .Cells(x, "B") = 1   And (.Cells(x, "E") = 3 Or .Cells(x, "E") _
= 5) Then
.Range("B" & x & ",E" & x & ",H" & x).Copy
ZielZelle.PasteSpecial xlPasteAll
Set ZielZelle = ZielZelle.Offset(1, 0)
End If
Next
End With
Application.CutCopyMode = False
Sheets("Tabelle2").Activate
Cells(1, 1).Select
Application.ScreenUpdating = 1
MsgBox "Fertig alle Zeilen > 3000 wurden kopiert"
End Sub

Gruß, Daniel

Sub Schaltfläche1_BeiKlick() Dim x As Long Dim ZielZelle As Range Set ZielZelle = Sheets("Tabelle2").range("A1") Application.ScreenUpdating = 0 With Sheets("Tabelle1") x = 1 .Range("B" & x & ",E" & x & ",H" & x).Copy ZielZelle.PasteSpecial xlPasteAll Set ZielZelle = ZielZelle.Offset(1, 0) For x = 2 To 50 If .Cells(x, "J") > 3000 And .Cells(x, "B") = 1 And (.Cells(x, "E") = 3 Or .Cells(x, " _ E") _ = 5) Then .Range("B" & x & ",E" & x & ",H" & x).Copy ZielZelle.PasteSpecial xlPasteAll Set ZielZelle = ZielZelle.Offset(1, 0) End If Next End With Application.CutCopyMode = False Sheets("Tabelle2").Activate Cells(1, 1).Select Application.ScreenUpdating = 1 MsgBox "Fertig alle Zeilen > 3000 wurden kopiert" End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread