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
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
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
Ich habe von den Befehlen in diesem Makro gar nichts verstanden. Aber es funktioniert super!
Du bist ein Genie!
Besten Dank!
Gruß
Manfred

