Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Zeilen kopieren bzw. verschieben





Frage

Hallo liebe VBA-Cracks, habe da folgendes Problem: In einer "Tabelle1" sollen Zeilen von Spalte A bis Spalte T in "Tabelle2" kopiert werden. Die kopierten Zeilen sollen immer fortlaufend in "Tabelle2" daruntergeschrieben werden. Aber erst ab Zeile 8. Dieses ganze soll an eine Bedingung geknüpft sein die lautet: Wenn in "Tabelle1" in Spalte AA eine 3 steht, soll halt die entsprechende Zeile von Spalte A bis Spalte T in "Tabelle2" rüberkopiert werden, aber erst ab Zeile 8 und dann fortlufend darunter. Bin mir sicher, dass einer darauf eine Antwort. Habe schon in zahlreichen Foren geguckt, aber noch nichts passendes gefunden. Bedanke mich schonmal im vorraus für eure Hilfe

Antwort 1 von coros

Hi VBANoop,

anbei ein VBA- Code, der das machen sollte, was Du Dir vorgestellt hast. Kopiere ihn in das VBA Projekt des Tabellenblattes mit dem Namen "Tabelle1".

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim erste_freie_Zeile As Long
If Target.Column = 27 And Target.Cells = 3 Then
erste_freie_Zeile = Sheets("Tabelle2").Range("A65536").End(xlUp).Offset(1, 0).Row
Range(Cells(Target.Row, 1), Cells(Target.Row, 20)).Copy
If erste_freie_Zeile < 8 Then erste_freie_Zeile = 8
Sheets("Tabelle2").Cells(erste_freie_Zeile, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End Sub


Mit dem Code wird Dir die Zeile, in der in Spalte AA der Wert 3 steht, in das Tabellenblatt "Tabelle2" in die erste freie Zeile kopiert.

Ich hoffe, Du meintest das so und das Du klar kommst. Bei Fragen melde Dich bitte wieder.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 2 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 2 von VBANoop

Danke erstma, das ist das was ich gebraucht habe.
Allerdings hatte Ich vergessen zu erwähnen, dass das rüberkopieren mittels Button erledigt werden soll.
Wie muss den der Code dafür abgeändert werden??

Antwort 3 von VBANoop

Oh, nochwas: Das ganze soll in Tabelle2 erst ab Zeile 8 runterkopiert werden

MfG VBANoop

Antwort 4 von coros

Hallo VBANoop,

dann setze den Code zwischen ein CommandButton- Ereignis. Erstelle in Deinem Tabellenblatt 1 einen Button aus der Symbolleiste "Steuerelement Toolbox". Kopiere danach nachfolgenden Code in das VBA Projekt des Tabellenblattes, in dem Du den Button positioniert hast.

Option Explicit

Private Sub CommandButton1_Click()
Dim erste_freie_Zeile As Long, i As Long
Application.ScreenUpdating = False
For i = 1 To Sheets("Tabelle1").Range("A65536").End(xlUp).Row
If Cells(i, 27) = 3 Then
erste_freie_Zeile = Sheets("Tabelle2").Range("A65536").End(xlUp).Offset(1, 0).Row
Range(Cells(i, 1), Cells(i, 20)).Copy
If erste_freie_Zeile < 8 Then erste_freie_Zeile = 8
Sheets("Tabelle2").Cells(erste_freie_Zeile, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next
End Sub


Bei dem Code wird immer wenn Du den Button betätigst, die Spalte AA nach dem Wert 3 durchsucht. Gefunden, wird die Zeile von A bis T kopiert und in die erste freie Zeile in Tabelle 2 eingefügt.
Wobei ich mal vermute, dass diese Lösung immer noch nicht richtig ist, da Zeilen, die in einem vorherigen Durchlauf bereits kopiert wurden erneut aufgeführt werden, da immer ab der ersten freien Zeile eingefügt wird. Aber da Du mit Deinen Infos etwas spärlich bist, konnte ich mir eine Variante aussuchen und das ist diese hier. Wenn das nicht richtig ist, melde Dich bitte wieder, dann aber mit ein paar mehr Infos, wie z.B. es sollen keine Bereiche doppelt kopiert oder in Tabelle2 auftauchen.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 5 von bibahutzelmann

Vielen Dank, auch ich bin einen grossen Schritt weiter gekommen. Noch eine Frage: Wie kann ich einstellen, dass die Zeilen, die er aus Tabelle1 uebertragen hat nach dem Kopieren geloescht werden??

Antwort 6 von Bibahutzelmann

Fuer was stehen eigentlich die "i" in dem Code, z. B.

For i = 1
If Cells(i, 27)
usw.

??

Danke, Jan

Antwort 7 von coros

Moin Jan,

sorry, dass ich erst jetzt reagiere, hatte aber vorher leider keine Zeit.

Zu AW 5: Dann sieht das Makro wie folgt aus. Kopiere es in das VBA- Projekt des Tabellenblattes, in dem die Daten in Spalte AA auf den Wert 3 geprüft werden sollen. Erstelle außerdem noch einen Button aus der Symbolleiste Steuerelement-Toolbox.

Option Explicit

Private Sub CommandButton1_Click()
Dim erste_freie_Zeile As Long, i As Long
Application.ScreenUpdating = False
For i = 1 To Sheets("Tabelle1").Range("A65536").End(xlUp).Row
If Cells(i, 27) = 3 Then
erste_freie_Zeile = Sheets("Tabelle2").Range("A65536").End(xlUp).Offset(1, 0).Row
Range(Cells(i, 1), Cells(i, 20)).Copy
If erste_freie_Zeile < 8 Then erste_freie_Zeile = 8
Sheets("Tabelle2").Cells(erste_freie_Zeile, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Rows(i).ClearContents
End If
Next
Range(Cells(1, 1), Cells(Sheets("Tabelle1").Range("A65536").End(xlUp).Row, 1)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub


Zu AW 6: In den Buchstaben "i" wird die aktuelle Schleifendurchlaufzahl eingetragen. Das mal an einem kleinen Beispiel erklärt.
Mal angenommen es steht dort die Befehlszeile

For i = 1 to 10


und wir wollen in einer bestimmten Zeile etwas suchen.
Dann bedeutet das, dass die Schleife 10x durchlaufen wird. Es wird in der 1. Zeile angefangen (sagt in diesem Beispiel der Wert 1 aus) und es wird bis zur Zeile 10 (sagt der Wert 10 aus) geprüft. Wird die Schleife gestartet, wird die erste Zeile durchsucht. Da es sich hierbei um den ersten Schleifendurchlauf handelt, wird in die Variable "i" der Wert 1 eingetragen. Dieser Wert kann dann z.B. als Zeilenindexnummer der gerade durchsuchten Zeile, oder wenn man Spalten durchsuchen möchte, als Spaltenindexnummer herangezogen werden. Das ganze geht dann bis zur Zeile 10, so dass beim letzten Schleifendurchlauf der Wert 10 in der Variablen steht. Das die Variable den Buchstaben "i" erhalten hat liegt einfach nur daran, das man in Programmierkreisen immer irgendwie in den Variablennamen den deklarierten Variablentyp integriert. Da die Variable den Typ "Integer" hat, eben das "i". Man hätte die Variable auch "iCol" für "Integer" und "Spalte" oder "iRow" für "Integer" und "Zeile" oder einfach auch nur Hans, Klaus oder Holger nennen können. Da sind den Phantasien keine Grenzen gesetzt. Ich mache das in meinen Beispielen meistens auch, dass ich dort Klartext schreibe, damit man das besser nachvollziehen kann. In diesem Beispiel hätte ich dann z.B. anstelle des Buchstaben "i" z.B. das Wort "Spalte" genommen.

So, ich hoffe, Du wirst schlau aus dem was ich geschrieben habe. Bei Fragen melde Dich bitte.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 8 von bibahutzelmann

Hallo Oliver, dankeschoen.

Hab das Formular und Button eingebunden. Jetzt schreib er mir folgenden Fehler: "Cannot use this command on overlapping sections". (bin gerade in USA und arbeite mit US-Version von Excel. Bei der Fehlermeldung wird die zweitletzte Zeile gelb markiert. Ich hab den Code oben umgebaut, dass er mir die Zeile Z (25) nach einer "1" durchsucht.

In meiner Test-Datei hat alles geklappt. Allerdings hat er beim zweiten klick (nachdem er beim ersten alles sortiert hat) einen Fehlercode gemeldet, dass keine Daten mehr zur Verfuegung stehen. Kann man anstatt der Fehlermeldung eine Messagebox oeffnen lassen?

Danke!!!

Antwort 9 von coros

Hi bibahutzelmann,

so ganz kann ich nicht nachvollziehen, was Du für ein Formular und Button wo und wie eingebunden hast. Besteht die Möglichkeit, dass Du Deine Datei z.B. bei www.netupload.de mal ins Netzt stellst und den Link hier postest, damit man sehen kann, wie Du das Makro eingebunden hast und wo der Fehler eventuell liegt.

Das mit der Meldung kann man auch realisieren. Du musst am Anfang des Makros die Befehlszeile

On Error GoTo Errorhandler


einsetzen. Diese bewirkt, dass bei einem Fehler in dem Makro alle Befehlszeilen übersprungen werden, bis die Sprungmarke "Errorhandler" erreicht wird. Erst ab dieser Sprungmarke wird das Makro weiter abgearbeitet. Dann musst Du am Ende des Makros die Zeilen

Exit Sub
Errorhandler:
Select Case Err
Case 1004
MsgBox "Sie haben einen Fehler verursacht. Die Funktion wird beendet.", vbCritical, "Fehler..."
Else
MsgBox "Es ist ein unerwarteter Fehler aufgetretren"
End Select


einsetzen. Hier wird die Sprungmarke definiert. Dann wird anhand einer Select- Anweisung die Fehlernummer ausgewertet. In diesem Beispiel, wenn der Fehler die Laufzeitfehlernummer 1024 hat, erscheint die erste MessageBox, ansonsten, also bei jedem anderen Fehler, erscheint die 2. Messagebox. Somit kann man für die Laufzeitfehlermeldungen eigene Fehlermeldungen anzeigen. Man kann auch mehrere Fehlernummer auswerten. Dazu nach der 1. Messagebox eine weitere

Case 9
MsgBox "Sie haben schon wieder einen Fehler verursacht. Die Funktion wird auch hier beendet.", vbCritical, "Neuer Fehler..."


Auswertung einsetzen. Hier wird der Laufzeitfehler mit der Nummer 9 ausgewertet.

So, ich hoffe, Du kommst klar. Bei Fragen melde Dich bitte wieder. Wie schon geschrieben, für den ersten Teil Deiner Frage benötigt man wohl Deine Datei.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 10 von bibahutzelmann

Hallo Oliver, brauche nochmals Deine Hilfe!
Das Kopieren hat geklappt. Allerdings schaffe ich es nicht, dass die ZEILEN auf dem Blatt, wo die Zeilen verschwinden sollen GELÖSCHT werden. Nur der Inhalt wird gelöscht, aber die Rahmen etc. bleiben stehen.

Habe die Datei auf meinen Webspace geladen: http://www.hutzel.info/liste.xls

Schaust Du bitte mal rein?
Du musst die vier unteren "Ampeln" alle auf GRÜN umstellen und oben auf "List update" klicken. Dankeschön!

Antwort 11 von coros

Hallo,

das bei Dir die Zeile nicht gelöscht wurde, lag an Deiner Fehlerbehandlung. So wie Du die Fehlerbehandlung aus AW 9 bei Dir eingefügt hast, wurde immer in die Case-Anweisung gesprungen und somit keine Zeile gelöscht. Ich habe den Code mal etwas umgestellt und so sollte er funktionieren. Lösche bitte den alten und verwende den nachfolgenden Code.

Private Sub CommandButton1_Click()
ActiveSheet.Unprotect
Dim erste_freie_Zeile As Long, i As Long
Application.ScreenUpdating = False
For i = 1 To Sheets("PhaseOut List").Range("A65536").End(xlUp).Row
If Cells(i, 24) = 1 Then
erste_freie_Zeile = Sheets("PhaseOut Complete").Range("A65536").End(xlUp).Offset(1, 0).Row
Range(Cells(i, 1), Cells(i, 20)).COPY
If erste_freie_Zeile < 3 Then erste_freie_Zeile = 3
Sheets("PhaseOut Complete").Cells(erste_freie_Zeile, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Rows(i).ClearContents
End If
Next
On Error Resume Next
Range(Cells(1, 1), Cells(Sheets("PhaseOut List").Range("A65536").End(xlUp).Row, 1)).SpecialCells(xlCellTypeBlanks).EntireRow.DELETE
On Error GoTo 0
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowInsertingRows:=True, AllowFiltering:= _
        True
End Sub


MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 12 von bibahutzelmann

Hallo Oliver, habe den Text 1:1 kopiert und eingefuegt. Jetzt erscheinen wenigstens nicht mehr die Fehlermeldungen, danke. Aber das Problem mit den Zeilen bleibt... der Inhalt wird geloescht, aber die Zeile an sich mit den Rahmen bleibt stehen.

Antwort 13 von coros

Hallo bibahutzelmann,

ich habe das an Deiner Datei getestet und da hat es funktioniert. Ich habe dazu in der Zeile (Zeile 12) unter dem letzten Eintrag etwas einegtragen, dann die 4 farbigen Felder in Zeile 11 auf Done gestellt und den Button betätigt. Es wurde die Zeile kopiert und in dem alten Blatt gelöscht, so dass der von mir neue Eintrag aus Zeile 12 eine Zeile höher in Zeile 11 gerutscht ist. Das soll doch so sein oder?

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 14 von bibahutzelmann

Ja, schon. Aber um es perfekt zu machen, sollte er die ganze ZEILE loeschen. Im Moment loescht er nur den INHALT dieser Zellen, sodass die Rahmen stehen bleiben. Die Rahmen sollen aber verschwinden.

Antwort 15 von coros

Hallo bibahutzelmann,

hast Du das eigentlich mal ausprobiert? Wenn ich das so mache, wie ich es in AW 13 beschrieben habe, rutscht alles eine Zeile höher. Somit wird auch der Rahmen gelöscht. In Deiner Beispieldatei sind Rahmen bis Zeile 15. Wenn ich das aus AW13 beschrieben durchführe, sind nur noch Rahmen bis Zeile 14. Ergo, die Zeile wurde gelöscht.

Wo ist nun das Problem?

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 16 von bibahutzelmann

Klar hab ich´s getestet. Aber trotzdem verschwinden bei mir nicht die Zeilen, sondern nur der Inhalt...

Antwort 17 von coros

Hallo bibahutzelmann ,

dann versuch es mal mit nachfolgendem Makro.

Private Sub CommandButton1_Click()
ActiveSheet.Unprotect
Dim erste_freie_Zeile As Long, i As Long
Application.ScreenUpdating = False
For i = Sheets("PhaseOut List").Range("A65536").End(xlUp).Row To 1 Step -1
If Cells(i, 24) = 1 Then
erste_freie_Zeile = Sheets("PhaseOut Complete").Range("A65536").End(xlUp).Offset(1, 0).Row
Range(Cells(i, 1), Cells(i, 20)).COPY
If erste_freie_Zeile < 3 Then erste_freie_Zeile = 3
Sheets("PhaseOut Complete").Cells(erste_freie_Zeile, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Rows(i).Delete
End If
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowInsertingRows:=True, AllowFiltering:= _
        True
End Sub


MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 18 von bibahutzelmann

Jetzt kappt es!!! Optimopti, ich bin begeistert. Danke Dir Oliver!!!

Antwort 19 von coros

Hi bibahutzelmann,

na bitte, haben wir es hinbekommen. Danke Dir für die Rückmeldung.

MfG,
Oliver
Jeder macht was er will, keiner macht was er soll, aber alle machen mit.

Antwort 20 von bibahutzelmann

Doch noch ein kleines Problem: Sheet "PhaseOut Complete", also wo alles hin kopiert wird, soll GESCHÜTZT werden, damit man spaeter an den Eintraegen nichts mehr veraendern kann. D. h. der Schutz muss vor dem Einfuegen deaktiviert und anschliessen wieder aktiviert. Aber so wie ich´s in den letzten 45 Minuten ausprobiert habe, klappts nicht. Da kommt immer eine Fehlermeldung.

Antwort 21 von coros

Hallo ,

nachfolgend, das Makro, wie es funktionieren sollte. Die Befehle für das Aufheben und Setzen des Blattschutzes habe ich mal Fett dargestellt.

Private Sub CommandButton1_Click()
ActiveSheet.Unprotect
Dim erste_freie_Zeile As Long, i As Long
Application.ScreenUpdating = False
Rem: Anstelle des Textes "Hier eventuelles Passwort eintragen"
Rem: gehört das Blattschutzpasswort zwischen die Anführungszeichen
Sheets("PhaseOut List").Unprotect "Hier eventuelles Passwort eintragen"
For i = Sheets("PhaseOut List").Range("A65536").End(xlUp).Row To 1 Step -1
If Cells(i, 24) = 1 Then
erste_freie_Zeile = Sheets("PhaseOut Complete").Range("A65536").End(xlUp).Offset(1, 0).Row
Range(Cells(i, 1), Cells(i, 20)).Copy
If erste_freie_Zeile < 3 Then erste_freie_Zeile = 3
Sheets("PhaseOut Complete").Cells(erste_freie_Zeile, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Rows(i).Delete
End If
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowFiltering:= _
True
Rem: Anstelle des Textes "Hier eventuelles Passwort eintragen"
Rem: gehört das Blattschutzpasswort zwischen die Anführungszeichen
Sheets("PhaseOut List").Protect "Hier eventuelles Passwort eintragen"
End Sub


MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 22 von bibahutzelmann

Danke! Folgend der Code, mit dem alles funktioniert hat. Ein Danke noch mal an Oliver!

Private Sub CommandButton1_Click()
ActiveSheet.Unprotect
Dim erste_freie_Zeile As Long, i As Long
Application.ScreenUpdating = False
Sheets("PhaseOut List").Unprotect
Sheets("PhaseOut Complete").Unprotect
For i = Sheets("PhaseOut List").Range("A65536").End(xlUp).Row To 1 Step -1
If Cells(i, 24) = 1 Then
erste_freie_Zeile = Sheets("PhaseOut Complete").Range("A65536").End(xlUp).Offset(1, 0).Row
Range(Cells(i, 1), Cells(i, 20)).COPY
If erste_freie_Zeile < 3 Then erste_freie_Zeile = 3
Sheets("PhaseOut Complete").Cells(erste_freie_Zeile, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Rows(i).DELETE
End If
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowFiltering:= _
True
Sheets("PhaseOut Complete").ProtectSheets("PhaseOut List").Protect
End Sub