Zeilen ohne Nullwerte ausgeben

Hallo Forum,
ein recht banales Thema beschäftigt mich (mit Unterbrechungen) den ganzen Tag. Ich komme nicht hin.
To Do:
Ich möchte aus einer Liste mit Terminen ("Termin"B6:D106) alle Termine mit Datum heute oder älter (=überfällige) in Tabelle T.Ex auflisten. Aus der "Termine" Tabelle sollen dabei in T.Ex beginnend ab A1 abgebildet werden:
"Termin" Spalte B: Name
"Termine" Spalte C: Schlagwort Termin
"Termine" Spalte D: genaue Beschreibung
"Termine" Spalte E: Fälligkeitstag Termin
Erklärungen:
In "Termine" Spalte G steht ein Prüfkriterium (0=ok, 1=überfällig). Wenn 1, dann soll Zeile nach T.Ex gehen.
Die Termine sind bunt gewürfelt, also nicht alle überfälligen oben und alle übrigen unten. Es kann Prüfzeilen geben, die einen Nullwert haben, der soll nicht übernommen werden.
Arry Formeln harmonieren nich mit wenn Prüfkriterium 1, dann kopieren. Die in diversen Foren gehandelten VBA Makros zu "Kopieren ohne Nullwerte" kann ich mangeels Know How nicht umschreiben, da ich ja 3 Zellen je Zeile (Schlagwort, genaue Beschreibung, Fälligkeit) kopieren muss.
Falls jemand eine schöne Idee hat, ist mir diese sehr willkommen. Ich bin wieder ab morgen früh im Netz.
Danke schon mal
Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Machen() Dim c As Range Termine.Range("A1").CurrentRegion.Copy TEx.Range("A1").PasteSpecial Paste:=xlValues Application.CutCopyMode = False TEx.Range("A1").CurrentRegion.Sort _ Key1:=TEx.Range("G1"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Set c = TEx.Range("G:G").Find(What:="0") If c Is Nothing Then Exit Sub TEx.Rows(c.Row & ":" & TEx.Range("A1").CurrentRegion.Rows.Count).Delete TEx.Columns("A").Delete ' so dann auch auf Wunsch weitere Spalten End Sub

Hi Stefan,
man sollte einfach keine Makros ohne Beispieldatei schreiben...
Range("A1").CurrentRegion ist der Bereich, der mit der Zelle A1 "zusammenhängt". Wenn die Zellen um A1 herum leer sind, funktioniert das so nicht.
Ersetze das "A1" mal durch "G1" - G1 muß ja schließlich vorhanden sein.
Aaaaber: wenn zwischen Deinen Daten in B-D und der Spalte G eine leere Spalte ist, haut das auch nicht hin...
Sag, meine Beispieldatei geht aber?
Also, auf ein Neues:

Sub machen()
Dim c As Range
Dim bis As Long
' hier wird ermittelt, wo der unterste Wert steht
' falls Spalte "C" oder "D" "länger" sind, ersetzt Du "B"
bis = Termine.Range("B" & Rows.Count).End(xlUp).Row
Termine.Range("A1:G" & bis).Copy
TEx.Range("A1").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
TEx.Range("A1:G" & bis).Sort _
Key1:=TEx.Range("G1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Set c = TEx.Range("G:G").Find(What:="0")
If c Is Nothing Then Exit Sub
TEx.Rows(c.Row & ":" & bis).Delete
TEx.Columns("A").Delete
' so dann auch auf Wunsch weitere Spalten
End Sub

Datei: https://www.herber.de/bbs/user/103084.xls
Schöne Grüße,
Michael

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen ohne Nullwerte ausgeben

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

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread