Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

autom.Verschieben von Zeilen in ein anderes Tabellenblatt





Frage

Hallo Miteinander! Kann ich im Excel folgendes tun: Bei einer Liste mit div. Eintragungen am Ende einer Zeile in ein Feld z.B. einen Haken setzen, der dann 1.)die gesamte Zeile in ein anderes Tabellenblatt kopiert (in diesem Beispiel von "aktuelle Projekt" in "erledigte Projekte") und 2.)die darunterliegenden Zeilen nach oben schiebt Hoffe das geht! Gruß Manfred

Antwort 1 von nighty

hi manne :)

das ist einfach :)

hier ein makro was dieses tut :)

Sub makro01()
GoSub lz
lz1 = lzeile
For t% = 1 To lz1

rem hier anstatt des pluszeichens dein zeichen bzw. haeckchen(was es nicht gibt) setzen
rem spalte c wird zur zeit durchsucht,deinen wuenschen anzupassen (es ist die spalte des haeckchens anzugeben).

If Range("C" & t%) = "+" Then

Range(t% & ":" & t%).Select
Selection.Copy
Sheets("erledigte Projekte").Select
GoSub lz
lzeile = lzeile + 1
Range(lzeile & ":" & lzeile).Select
ActiveSheet.Paste
Range("A" & t%).Select
Sheets("aktuelle Projekt").Select
Range(t% & ":" & t%).Select
Selection.Delete Shift:=xlUp
Range("A" & t%).Select
End If
Next t%
End
lz:
Set LastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = LastCell.Row
a = LastCell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
altb = LastCell.Column
b = LastCell.Column
Do While Application.CountA(Columns(b)) = 0 And b <> 1
b = b - 1
Loop
altb = b
lzeile = alta
lspalte = altb
Return
End Sub


gruss nighty

Antwort 2 von nighty

hi manne :)

nochmal ich :)

oder weil oben nur auf eine fundstelle bezogen hier nun beliebig viele :)
handhabung wie oben.

gruss nighty

Sub makro01()
GoSub lz
lz1 = lzeile
For t% = 1 To lz1
If Range("C" & t%) = "+" Then
Range(t% & ":" & t%).Select
Selection.Copy
Sheets("Tabelle2").Select
GoSub lz
lzeile = lzeile + 1
Range(lzeile & ":" & lzeile).Select
ActiveSheet.Paste
Range("A" & t%).Select
Sheets("Tabelle1").Select
Range(t% & ":" & t%).Select
Selection.Delete Shift:=xlUp
Range("A" & t%).Select
t% = t% - 1
End If
Next t%
End
lz:
Set LastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = LastCell.Row
a = LastCell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
altb = LastCell.Column
b = LastCell.Column
Do While Application.CountA(Columns(b)) = 0 And b <> 1
b = b - 1
Loop
altb = b
lzeile = alta
lspalte = altb
Return
End Sub


Antwort 3 von Manfred

Hallo nighty!

Ich habe von den Befehlen in diesem Makro gar nichts verstanden. Aber es funktioniert super!
Du bist ein Genie!
Besten Dank!


Gruß
Manfred