Supportnet / Forum / Tabellenkalkulation

Hallo, ich habe ein Poblem in einem Aktionsplan der Instandhaltungsarbeiten verwalten soll. Wenn in der Spalte H in einer beliebigen Zeile "Erl" eingetragen wird, kopiert sich die gesamte Zeile in ein neues Tabellenblatt, in diesem Fall mit Namen Erledigt der Code dazu sieht so aus und funktioniert auch. ***** Private Sub Worksheet_Change(ByVal Target As Range) Dim RaBereich As Range, RaZelle As Range Dim LoLetzte As Long Set RaBereich = Range("H:H") For Each RaZelle In Range(Target.Address) If Not Intersect(RaZelle, RaBereich) Is Nothing Then If RaZelle = "erl" Then With Worksheets("Erledigt") LoLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1 Range("A" & RaZelle.Row & ":J" & RaZelle.Row).Copy .Cells(LoLetzte, 1) End With End If End If Next RaZelle Set RaBereich = Nothing End Sub *** ich möchte aber erreichen, dass sich die Zeile auch automatisch aus der Ursprungstabelle löscht. hat jemand einen Tipp für mich ??

Hi,

versuche es mit diesem Code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LoLetzte As Long
    If Target.Column <> 8 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target = "Erledigt" Then
        LoLetzte = Worksheets("Erledigt").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
        Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Erledigt").Cells(LoLetzte, 1)
        Target.EntireRow.Delete
    End If
End Sub

Bis später,
Karin

Hallo opurnaut ,

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim RaBereich As Range, RaZelle As Range
Dim LoLetzte As Long

Set RaBereich = Range("H:H")
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If RaZelle = "erl" Then
With Worksheets("Erledigt")
Selection.Delete Shift:=xlUp
LoLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
Range("A" & RaZelle.Row & ":J" & RaZelle.Row).Copy .Cells(LoLetzte, 1)
Target.EntireRow.Delete
End With
End If
End If
Next RaZelle
Set RaBereich = Nothing
End Sub

Gruß
fedjo

Hi Fedlo,

im Worksheet_Change Ereignis hast du den Vorteil, dass Target als Range dimensioniert ist und somit die Eingabezelle direkt angesprochen werden kann, genau wie du es mit der Suchvariablen RaZelle machst, nur mit dem Unterschied, dass sie nicht erst gesucht werden muss.

Bis später,
Karin

das hat super funktioniert

vielen Dank !!

ich hab allerdings noch eine Frage

wie müsste der Code aussehen wenn nicht nur
eine Variable " Erledigt " gesucht und verschoben werden soll, sondern z.B. vier verschiedene
( Müller, Meier, Schulz,Frank)
in gleichnahmige Tabellenblätter verschoben werden sollten.

???

vorab schonmal Danke an die Pros ;-)

Hi,

deine Fragestellung ist nicht ganz klar. Ich nehme jedoch an, dass in Spalte H "erl" eingetragen werden soll und in Abhängigkeit davon, welcher Name in einer anderen Spalte steht, soll die Zeile in die entsprechende Tabelle verschoben werden. Ich weiß leider nicht, wo diese Namen stehen und bin deshalb einfach mal davon ausgegangen, dass sie in Spalte A stehen

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim loLetzte As Long
    If Target.Column <> 8 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target = "erl" Then
        Select Case Target.Offset(0, -7)
            Case "Müller"
                loLetzte = Worksheets("Müller").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Müller").Cells(loLetzte, 1)
                Target.EntireRow.Delete
            Case "Meier"
                loLetzte = Worksheets("Meier").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Meier").Cells(loLetzte, 1)
                Target.EntireRow.Delete
            Case "Schulz"
                loLetzte = Worksheets("Schulz").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Schulz").Cells(loLetzte, 1)
                Target.EntireRow.Delete
            Case "Frank"
                loLetzte = Worksheets("Frank").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Frank").Cells(loLetzte, 1)
                Target.EntireRow.Delete
        End Select
    End If
End Sub

Bis später,
Karin

Hi,

Danke für die schnelle Antwort,

Es ist eigentlich etwas einfacher

ich benötige keine abhängigkeit von der Spalte H

ich möchte einfach in Zeile F einen von vier verschiedenen Namen eingeben können und darauf soll sich die komplette Zeile in ein gleichnahmiges
Tabellenblatt verschieben.

Thx nochmal fürs helfen..

Hi,

wenn in Spalte H "Erledigt" eingetragen wird, wird der Bereich A:J in die Tabelle "Erledigt" verschoben, wenn in Spalte F die Namen eingetragen werden, wird der Bereich A:J in die Tabelle des entsprechenden Namen verschoben. Die Zeilen in der Ausgangstabelle werden jeweils gelöscht

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim loLetzte As Long
    If Target.Column <> 8 Or Target.Column <> 6 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 6 Then
        Select Case Target
            Case "Müller"
                loLetzte = Worksheets("Müller").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Müller").Cells(loLetzte, 1)
                Target.EntireRow.Delete
            Case "Meier"
                loLetzte = Worksheets("Meier").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Meier").Cells(loLetzte, 1)
                Target.EntireRow.Delete
            Case "Schulz"
                loLetzte = Worksheets("Schulz").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Schulz").Cells(loLetzte, 1)
                Target.EntireRow.Delete
            Case "Frank"
                loLetzte = Worksheets("Frank").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Frank").Cells(loLetzte, 1)
                Target.EntireRow.Delete
        End Select
    Else
        If Target = "Erledigt" Then
            loLetzte = Worksheets("Erledigt").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
            Range("A" & Target.Row & ":J" & Target.Row).Copy Worksheets("Erledigt").Cells(loLetzte, 1)
            Target.EntireRow.Delete
        End If
    End If
End Sub

Bis später,
Karin

• Zeilen mit #BEZUG# löschen
• Makro: Zellen mit Inhalt erkennen und kopieren
• Makro soll die richtige Zeile finden
• letzte beschriebene Zeile kopieren VBA
• jede 5 Zeile aus .txt Datei in Excel kopieren