cellen verplaatsen naar andere worksheets bij selectie van waarde listbox

[bjornesto]

Beste

Ik heb een bestandje gemaakt waarbij ik bij status achteraan kan kiezen uit volgende delen

In possession
Returned
Other

Nu heeft ieder onderdeel een aparte sheet (in possession is de eerste sheet).
Nu zou ik graag hebben dat als ik 1 van die drie keuzes selecteer hij deze automatisch verplaatst naar een ander sheet

Dit is mijn macro code en kan dit al verzetten naar Returned maar nog niet naar other

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
    If Target.Value = "Returned" Then
        Range(Target.EntireRow.Address).Cut Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End If
End If
End Sub

Kan iemand mij hierbij helpen

Bekijk bijlage Lend out of keys.xls

 

[Niels28]

Dat kan met bv select case.


Ik heb cut door copy vervangen zodat de rij verwijdert kan worden en je niet met lege rijen blijft zitten.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
    waarde = Target.Value
    Select Case waarde
        Case "Returned"
            Target.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Target.EntireRow.Delete shift:=xlUp
        Case "Other"
            Target.EntireRow.Copy Sheet3.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Target.EntireRow.Delete shift:=xlUp
        Case Else
    End Select
End If
End Sub

 

[bjornesto]

Beste

Dit werkt goed behalve als je in possession selecteert dan kopieert hij deze niet naar de map in possession is dit nog aan te passen of niet

 

[Niels28]

Ze staan toch al in het blad "in possession"?
Bedoel je dat als je ze op een andere tabblad verandert ze ook verplaatsen?
Haal dan je code achter blad1 weg een plaats volgende code in ThisWorkbook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count = 1 Then
    waarde = Target.Value
    Select Case waarde
        Case "Returned"
            If ActiveSheet.Name = "Returned" Then Exit Sub
            Target.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Target.EntireRow.Delete shift:=xlUp
        Case "Other"
            If ActiveSheet.Name = "Other" Then Exit Sub
            Target.EntireRow.Copy Sheet3.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Target.EntireRow.Delete shift:=xlUp
        Case "In possession"
            If ActiveSheet.Name = "In Possession" Then Exit Sub
            Target.EntireRow.Copy Sheet1.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Target.EntireRow.Delete shift:=xlUp
        Case Else
    End Select
End If
End Sub

Niels

 

[bjornesto]

Beste niels

Dit werkt perfect dank u