Zeile Automatisch in anderes Tabellenblatt kopieren und im Ausgangsblatt löschen

[Schmith]

Hallo Zusammen,

bedingt durch meinen Job arbeite ich seit neuesten mit Excel (Version 2010). Leider halten sich meine Erfahrungen mit Excel sehr in Grenzen. Nun zu meiner Frage.
Ich habe eine Tabellenblatt 1 mit mehreren Abfragen wie z.B. (Bestellungen, Einrichtung, Status, Liefertermin usw.). In der Spalte H wird der Status abgefragt (z.B. Anwender, Bestellschreibung, Unterschriftenrund, Versendet usw.) Nun möchte ich gerne, wenn ich den Status Versendet auswähle, dass dann Automatisch die ganze Zeile in Tabellenblatt 1 verschwindet (löschen oder ausblende) und nach Tabellenblatt 2 kopiert wird. Nun wäre meine Frag ob es funktioniert und ob jemand eine Idee hat wie ich es umsetzen kann? Hätte euch gerne ein Foto eingefügt, aber selbst das scheint für mich schwierig zu sein.Ich habe im Tabellenblatt 1 ein Makro welcher veranlasst: Wenn beim Status (Spalte H) ein Eintrag erfolgt dann soll Automatisch das Datum in der nächsten Spalte aktualisiert werden. Aber nur wenn es geändert wird. Hoffe das ist kein Problem  

Hier der Eintrag:
Sub Worksheet_Change(ByVal Target As Range)
     If Intersect(Target, Range("H2:H999")) Is Nothing Then Exit Sub
     If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
     If Target = "" Then
         Target.Offset(0, 1).ClearContents
         Else:
         Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
     End If
 End Sub

  Ich danke euch schon einmal für eure Antworten.

[WillWissen]

Hi,

Hätte euch gerne ein Foto eingefügt, aber selbst das scheint für mich schwierig zu sein.

das ist auch gut so. ;)   Statt eines Bildes ist es immer besser eine Beispieldatei oder einen Tabellenausschnitt zu posten.

Lies doch bitte diesen Beitrag durch.

[Schmith]

Hallo WillWissen,

danke für den Hinweis. Hab jetzt die Tabelle angehangen :17:

[atilla]

Hallo,

statt Deines bisherigen Codes den unten stehenden mal testen Es sind keinerlei Plausibilität-oder Fehlerprüfungen enthalten.
Die Spalte B muss immer einen Wert enthalten darf aber nicht weiter gefüllt sein als Daten in den anderen Spalten enthalten sind.
Die Spalte Zeigt mir an, bis wo Daten enthalten sind. Das benötige ich zum Sortieren nach dem Löschen der übertragenen Zeile, damit nicht zwischendurch leer Zeilen entstehen.

Code:

Sub Worksheet_Change(ByVal Target As Range)
   Dim lngZ As Long
   If Intersect(Target, Range("H2:H999")) Is Nothing Then Exit Sub
   If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
   If Target = "" Then
       Target.Offset(0, 1).ClearContents
   Else
       Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
       With Sheets("Tabelle2")
           lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
           .Range(.Cells(lngZ, 1), .Cells(lngZ, 13)) = Range(Cells(Target.Row, 2), Cells(Target.Row, 14)).Value
           Application.EnableEvents = False
           Range(Cells(Target.Row, 2), Cells(Target.Row, 14)).ClearContents
           lngZ = Cells(Rows.Count, 1).End(xlUp).Row
           Range(Cells(1, 2), Cells(lngZ, 14)).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes
           Application.EnableEvents = True
       End With
   End If
End Sub

[Rabe]

Hi,

Ich habe im Tabellenblatt 1 ein Makro welcher veranlasst: Wenn beim Status (Spalte H) ein Eintrag erfolgt dann soll Automatisch das Datum in der nächsten Spalte aktualisiert werden. Aber nur wenn es geändert wird. Hoffe das ist kein Problem  

hier mal Dein Makro erweitert um das verschieben:

Option Explicit

Dim Zeile As Long

Dim loLetzte As Long, loLeere As Long



Sub Worksheet_Change(ByVal Target As Range)

  If Intersect(Target, Range("H2:H999")) Is Nothing Then Exit Sub

  If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen 

  If Target = "" Then

     Target.Offset(0, 1).ClearContents

  Else:

     Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))

  End If

  If Target = "Versendet" Then

     Zeile = ActiveCell.Row

     loLetzte = Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row                 ' letzte belegte in Spalte A (1) 

     loLeere = loLetzte + 1

     Worksheets("Tabelle1").Rows(Zeile).Cut                                               ' Ausschneiden 

     Worksheets("Tabelle2").Rows(loLeere).EntireRow.Insert Shift:=xlDown                  ' Einfügen 

     Worksheets("Tabelle1").Rows(Zeile).Delete

  End If

  

End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

Hier die erste If-Schleife umgedreht, dann wird kein Exit Sub benötigt:

Option Explicit
Dim Zeile As Long
Dim loLetzte As Long, loLeere As Long

Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("H2:H999")) Is Nothing Then
      If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen 
      If Target = "" Then
         Target.Offset(0, 1).ClearContents
      Else:
         Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
      End If
      If Target = "Versendet" Then
         Zeile = ActiveCell.Row
         loLetzte = Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row                 ' letzte belegte in Spalte A (1) 
         loLeere = loLetzte + 1
         Worksheets("Tabelle1").Rows(Zeile).Cut                                               ' Ausschneiden 
         Worksheets("Tabelle2").Rows(loLeere).EntireRow.Insert Shift:=xlDown                  ' Einfügen 
         Worksheets("Tabelle1").Rows(Zeile).Delete
      End If
   End If
   
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

[Rabe]

Hi,

statt Deines bisherigen Codes den unten stehenden mal testen Es sind keinerlei Plausibilität-oder Fehlerprüfungen enthalten.

Atillas Code mit korrigierten Spaltenzahlen:

Sub Worksheet_Change(ByVal Target As Range)
   Dim lngZ As Long
   If Intersect(Target, Range("H2:H999")) Is Nothing Then Exit Sub
   If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen 
   If Target = "" Then
       Target.Offset(0, 1).ClearContents
   Else
       Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
       With Sheets("Tabelle2")
           lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
           .Range(.Cells(lngZ, 1), .Cells(lngZ, 14)) = Range(Cells(Target.Row, 1), Cells(Target.Row, 14)).Value
           Application.EnableEvents = False
           Range(Cells(Target.Row, 1), Cells(Target.Row, 14)).ClearContents
           lngZ = Cells(Rows.Count, 1).End(xlUp).Row
           Range(Cells(1, 1), Cells(lngZ, 14)).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes
           Application.EnableEvents = True
       End With
   End If
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0