Zeilen per Button in andere Tabellenblätter verschieben

[e2Ki]

Mh...

Ich glaube wir reden aneinander vorbei:

Wenn ich eine Zeile von Reporting in (z.B.) Pendent kopiere, dann bleibt in dem Sheet "Pendent" die aktuelle Zeile 26 auf dem gleichen Blatt.
Angenommen ich kopiere jetzt 26 Datensätze in das Sheet "Pendent" wird die aktuelle Zeile 26 überschrieben mit dem neuen Inhalt.

In einer vorherigen Version ist die aktuelle Zeile 26 auf Zeile 27 gerutscht, wenn ich eine Zeile hinein kopiert habe, nachdem ich "Application.CutCopyMode = " auf True gesetzt hatte.


Es ist immer blöd, wenn einer zu wenig Ahnung hat (ich ^^) um sich richtig verständlich machen zu können - aber vielleicht kannst du mein Anliegen dennoch verstehen =)



Klaus Dieter:

Das wäre durchaus auch eine Überlegung wert.....
Dann müsste ich das Layout etwas anpassen aber der Gedanke ist gut! Vielen Dank dafür!

[Frogger1986]

Das Makro Prüft in der Ersten Spalte immer auf die Letzte Zeile und schreibt dann in die nächste freie Zeile! Außer man leert natürlich in Spalte 1 die letzten Zellen! 

ES WIRD IMMER EINE GANZE ZEILE KOPIERT!!!!!

Bei mir funktioniert das alles wie es soll...! Mit "Application.cutcopymode" hat das nichts zu tun! Diese Anweisung beendet lediglich den Kopiervorgang!

[e2Ki]

Ich danke euch für die schnelle Hilfe!

Es funktioniert nun alles genau so wie es soll.

Beste Grüsse und einen schönen Abend!

[e2Ki]

Jetzt habe ich doch noch einmal eine Frage:

Ich habe versucht den Code von Sheet1 auf Sheet2 zu übertragen, damit ich von dort aus Zeilen auch weiter kopieren kann. 
Sprich: Wenn ich in Sheet "Abgeschlossen" eine Zeile auf Status "Pendent" setze, dann soll diese Zeile auch in das Sheet "Pendent" kopiert werden.
soweit so gut.

Ich habe den Code (vermutlich laienhaft) angepasst, dass es funktioniert.
Das Kopieren geht wunderbar.

Nun habe ich aber das Problem, dass ich Leerzeilen in das Sheet eingefügt bekomme.
Wenn ich 10 Zeilen mit Status "Abgeschlossen" habe, dann werden 10 Leerzeichen darüber hinzugefügt.

folgenden Code habe ich genommen (eigentlich genau der von Frogger)

Code:

Sub Akt1()

On Error Resume Next

Application.ScreenUpdating = False
For i = 5 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

       For Z = 1 To Sheets.Count

               If ActiveSheet.Cells(i, 1).Value = Sheets(Z).Name Then
                   Tab2 = ActiveSheet.Cells(i, 1).Value
                   Aktuell = Sheets(Tab2).Cells(Rows.Count, 1).End(xlUp).Row + 1
                   ActiveSheet.Rows(i).Copy
                   Sheets(Tab2).Select
                   Sheets(Tab2).Rows(Aktuell).PasteSpecial
                   Sheets("Abgeschlossen").Activate
                   ActiveSheet.Range(Cells(i, 1), Cells(i, 28)).ClearContents
               End If
       
       Next
Next
Application.CutCopyMode = True
Application.ScreenUpdating = True

End Sub

EDIT:


Mein Lösungsansatz:

Code:

Sub Akt1()

On Error Resume Next

Application.ScreenUpdating = False
For i = 5 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

       For Z = 1 To Sheets.Count

               If ActiveSheet.Cells(i, 1).Value = "Pendent" Then
                   Tab2 = ActiveSheet.Cells(i, 1).Value
                   Aktuell = Sheets(Tab2).Cells(Rows.Count, 1).End(xlUp).Row + 1
                   ActiveSheet.Rows(i).Copy
                   Sheets(Tab2).Select
                   Sheets(Tab2).Rows(Aktuell).PasteSpecial
                   Sheets("Abgeschlossen").Activate
                   ActiveSheet.Range(Cells(i, 1), Cells(i, 28)).ClearContents
               End If
       
       Next
                       If ActiveSheet.Cells(i, 1).Value = "NZG Abgelehnt" Then
                   Tab2 = ActiveSheet.Cells(i, 1).Value
                   Aktuell = Sheets(Tab2).Cells(Rows.Count, 1).End(xlUp).Row + 1
                   ActiveSheet.Rows(i).Copy
                   Sheets(Tab2).Select
                   Sheets(Tab2).Rows(Aktuell).PasteSpecial
                   Sheets("Abgeschlossen").Activate
                   ActiveSheet.Range(Cells(i, 1), Cells(i, 28)).ClearContents
               End If
               
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Geht es eleganter?

[Frogger1986]

Der code ist nicht so einfach anzupassen auf ein anderes Tabellenblatt.. Er ist für dein ursprüngliches Problem geschrieben.. Dazu musst du mehr umschreiben.. Warum soll das denn machbar sein erst von A nach B und dann wieder von B nach A … das macht doch irgendwie keinen Sinn...
Dann würde ich an deiner Stelle mir die Sache mit dem Autofilter vll. doch überlegen...

[Klaus-Dieter]

Hallo zusammen,

offenbar geht es hier: Office-Loesung Forum weiter.

[e2Ki]

Dort konnte man nicht helfen.

Ich wollte nur hier nicht weiter nerven

ich hab aber inzwischen die Lösungen wie beschrieben selbst erarbeitet.

Ist ggf. nicht besonders elegant - aber es funktioniert!

Ich lade hier auch nochmal die Musterliste hoch, vielleicht hilft es noch jemandem.

[Flotter Feger]

Dort konnte man nicht helfen.

... BOAH ... ist das dreist !!!

Boris hat sich für dich einen Wolf geschrieben ... aber dir war nichts gut genug.

Für die Äußerung sollte man dich sperren !!! Erst CP und dann auch noch sowas ... das ist echt das allerletzte.

Das musste ich jetzt einfach schreiben, auch wenn du das nie lesen wirst. Bei mir stehst du auf jeden Fall ab sofort auf der Ignore-List ... sowohl hier, als auch bei Office-Loesung !!!

[Frogger1986]

So hier die von A nach B und wieder zurück Lösung…. auch wenn's jetzt ne undankbare Arbeit war...

alten Code gegen diesen tauschen... Geht nur bis maximal 26 Zeilen in Tabelle "Repotring" (gebe dem ganzen am besten ne Tastenkombi in der Bsp. Datei mit "Strg+y")

Code:

Sub Akt()

On Error Resume Next

Application.ScreenUpdating = False

If ActiveSheet.Name <> "Reporting" Then
a = 1
g = Sheets(ActiveSheet.Name).Cells(Rows.Count, 1).End(xlUp).Row
Else
a = 5
g = 26
End If

For i = a To g

       For Z = 1 To Sheets.Count

               If ActiveSheet.Cells(i, 1).Value = Sheets(Z).Name And ActiveSheet.Cells(i, 1).Value <> ActiveSheet.Name Then
                   
                   Tab1 = ActiveSheet.Cells(i, 1).Value
                   Back = ActiveSheet.Name
                   If Tab1 <> "Reporting" Then
                           Aktuell = Sheets(Tab1).Cells(Rows.Count, 1).End(xlUp).Row + 1
                   Else
                           For y = 5 To 26
                                   If Sheets("Reporting").Cells(y, 1).Value = "" Then
                                           Aktuell = y
                                           Exit For
                                   End If
                           Next
                   
                   End If
                   
                   ActiveSheet.Rows(i).Copy
                   Sheets(Tab1).Select
                   Sheets(Tab1).Rows(Aktuell).PasteSpecial
                   Sheets(Back).Activate
                   
                   
                   
                   If Back <> "Reporting" Then
                           ActiveSheet.Rows(i).Delete Shift:=xl1Up
                   Else
                           Sheets("Reporting").Range(Cells(i, 1), Cells(i, 28)).ClearContents
                   End If
               
               End If
       
       Next
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

[Gast 123]

Hallo

obwohl ich bisher nicht im Thread war konnte ich mir nicht verkneifen auch mal über eine Lösung nachzudenken.  Hier meine Beispieldatei.

Statt die kopierten Zeilen zu löschen, wodurch sich der Reporting Bereich staendig aendern würde, sortiere ich die verbleibenden Daten über Spalte "D" nach oben.  Die Spalte und der Sortier-Bereich kann in Const selbst festgelegt werden.  Würde mich freuen wenn diese Idee passend ist.

mfg  Gast 123