Wegschrijven van regel naar ander werkblad

Severance1 · 13 apr 2010

Hallo allemaal,

Ik heb een vraag ( weet niet zeker of het mogelijk is in excel).
In de bijgevoegde excel sheet zitten twee stuks werkbladen.
Nu is mij vraag als ik in werkblad I de status van I naar U weizig, kan deze volledige regel dan ook weg geschreven worden naar werkblad U?

Ik hoop dat iemand mij hier een oplossing voor kan geven

?

Groeten,

Boudewijn.

danny147 · 13 apr 2010

Beste

Moet de regel in werkblad I dan ook gewist worden nadat hij weggeschreven is naar werkblad U ?

Wil je dit automatisch of via een knop ?

Groetjes Danny. :thumb:

danny147 · 13 apr 2010

Beste Severance1

Zie bestandje.

Indien je het anders wenst dan hoor ik het graag.

Groetjes Danny. :thumb:

Warme bakkertje · 13 apr 2010

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 7 And Target.Value = UCase("u") Then
        Sheets("U").[A65536].End(xlUp).Offset(1).EntireRow = Target.EntireRow.Value
    End If
End Sub

Severance1 · 14 apr 2010

danny147 zei:
Beste Severance1

Zie bestandje.

Indien je het anders wenst dan hoor ik het graag.

Groetjes Danny. :thumb:

Hallo Danny,

Ik heb het getest alleen als ik nu op wegschrijven klik blijven de over gebleven regels niet goed staan, de regels die niet op U staan zeg maar.
Het zou mooi zijn dat de regels die weg geschreven worden ook verwijderd worden en de cellen naar boven verplaatsen.
Ik denk dat je het wel ziet in het bijgevoegde bestand. Zodra je op wegschrijven klikt zie je het.
Ik hoop dat dit mogelijk is om te veranderen. Alvast bedankt.

Groeten,

Boudewijn.

danny147 · 14 apr 2010

Beste Severance1

verander een deel van de code.
nl. Clear in Delete

Code:

Sub wegschrijven()
Dim c As Range
Application.ScreenUpdating = False
   
    For Each c In Sheets(1).[G5:G100]
    On Error Resume Next
        If c = UCase("u") Then
            c.Rows.EntireRow.Copy Sheets(2).[A65536].End(xlUp).Offset(1, 0)
            c.Rows.EntireRow.[COLOR="Red"][B]Delete[/B][/COLOR]
        End If
    Next
Sheets(1).[G5:G100].Sort [G5]

Application.ScreenUpdating = True
End Sub

Zie bestandje.

Groetjes Danny. :thumb:

Severance1 · 14 apr 2010

Dit is het

bedankt.
Ik heb nog een laatste vraag. Kan ik een validatie lijst laten verschijnen als een andere cel 1 is, en als die cel 0 is dat de lijst er niet is?

Groeten,

Boudewijn

Warme bakkertje · 14 apr 2010

Of zo

Code:

Sub Wegschrijven()
  On Error Resume Next
  Do
    With Sheets("I").Columns(7).Find("U", , xlValues, xlWhole).EntireRow
       .Copy Sheets("U").Cells(Rows.Count, 1).End(xlUp).Offset(1)
       .Delete
     End With
  Loop Until Err.Number > 0
  [I!G5:G100].Sort [G5]
End Sub

HSV · 14 apr 2010

Severance1 zei:
Dit is het bedankt.
Ik heb nog een laatste vraag. Kan ik een validatie lijst laten verschijnen als een andere cel 1 is, en als die cel 0 is dat de lijst er niet is?

Groeten,

Boudewijn

Code:

Private Sub Worksheet_selectionChange(ByVal Target As Range)
If [A1].Value = 1 Then
[G5].Validation _
.Modify xlValidateList, , , "=Status"
Else
[G5].Validation.Modify xlValidateList = False
End If
End Sub

Met in A1 een nul of één, en in G5 je validatie.

danny147 · 14 apr 2010

Beste snb

Severance1 wil dat bereik G5:G100 een validatielijst komt te staan als er in bereik I5:I100 een 1 staat als er 0 staat dan geen validatielijst.

Ik kom er niet uit

Groetjes Danny. :thumb:

Warme bakkertje · 15 apr 2010

Zo zou het kunnen.

Code:

Sub ValiLijst()
For x = 5 To Sheets("I").UsedRange.Rows.Count + 2
If Cells(x, 9) = 1 Then
    With Cells(x, 7).Validation
        .Delete
        .Add xlValidateList, xlValidAlertStop, xlBetween, "=Status"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
Else
    Cells(x, 7).Validation.Delete
End If
Next
End Sub

Severance1 · 15 apr 2010

Warme bakkertje zei:

Zo zou het kunnen.

Code:

Sub ValiLijst()
For x = 5 To Sheets("I").UsedRange.Rows.Count + 2
If Cells(x, 9) = 1 Then
    With Cells(x, 7).Validation
        .Delete
        .Add xlValidateList, xlValidAlertStop, xlBetween, "=Status"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
Else
    Cells(x, 7).Validation.Delete
End If
Next
End Sub

Ik kom er niet helemaal uit als ik de code in dit bestand invul dan doet hij het niet

.
Heb je enig idee hoe dat komt?

Groeten,

Boudewijn

Warme bakkertje · 15 apr 2010

Ik wel

. Had je in de VBA-Help even gekeken naar Cells had je dit zonder veel moeite zelf kunnen vinden.

Code:

Sub ValiLijst()
    For x = 5 To Sheets("I").UsedRange.Rows.Count + 2
        If Sheets("I").Cells(x, [COLOR="Red"]16[/COLOR]) = 1 Then
            With Cells(x, 7).Validation
                .Delete
                .Add xlValidateList, xlValidAlertStop, xlBetween, "=Status"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        Else
            Sheets("I").Cells(x, 7).Validation.Delete
        End If
    Next
End Sub

danny147 · 15 apr 2010

Beste Severance1 :thumb:

En als je deze aangepaste code van Warme bakkertje in Blad1 plaatst in de VBA editor dan gaat het automatisch.

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    For x = 5 To Sheets("I").UsedRange.Rows.Count + 2
        If Sheets("I").Cells(x, 16) = 1 Then
            With Cells(x, 7).Validation
                .Delete
                .Add xlValidateList, xlValidAlertStop, xlBetween, "=Status"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        Else
            Sheets("I").Cells(x, 7).Validation.Delete
        End If
    Next
End Sub

Opgelet ! Enkel voor blad I

Groetjes Danny. :thumb:

Severance1 · 15 apr 2010

Het is gelukt jullie worden super bedankt

:thumb::thumb:

Groeten,

Boudewijn

HSV · 15 apr 2010

danny147 zei:
Beste snb
Ik kom er niet uit

Groetjes Danny. :thumb:

Ik ben er ook geen ster in, maar is toch gelukt.

Code:

Private Sub Worksheet_selectionChange(ByVal Target As Range)
    Dim c As Range
For Each c In [I5:I100]
      If c = 1 Then
         c.Offset(, -2).Validation.Modify xlValidateList, , , "=Status"
ElseIf c = 0 Then
       c.Offset(, -2).Validation.Modify xlValidateList = False
    End If
    On Error Resume Next
  Next
End Sub

danny147 · 15 apr 2010

Beste HSV

HSV zei:
Ik ben er ook geen ster in, maar is toch gelukt.

Het kunnen allemaal geen Wigi's, snb's of Warme bakkertjes zijn hé

Ik probeer ook maar mijn best te doen en zal wel zien wat het wordt.

Heb de code aangepast moest Severance1 nog eens komen opdagen.

Code:

Private Sub Worksheet_selectionChange(ByVal Target As Range)
    Dim c As Range
For Each c In [P5:P100]
      If c = 1 Then
         c.Offset(, -9).Validation.Modify xlValidateList, , , "=Status"
ElseIf c = 0 Then
       c.Offset(, -9).Validation.Modify xlValidateList = False
    End If
    On Error Resume Next
  Next
End Sub

Groetjes Danny. :thumb:

Severance1 · 16 apr 2010

danny147 zei:
Beste HSV

Het kunnen allemaal geen Wigi's, snb's of Warme bakkertjes zijn hé
Ik probeer ook maar mijn best te doen en zal wel zien wat het wordt.

Heb de code aangepast moest Severance1 nog eens komen opdagen.

Code:

Private Sub Worksheet_selectionChange(ByVal Target As Range) Dim c As Range For Each c In [P5:P100] If c = 1 Then c.Offset(, -9).Validation.Modify xlValidateList, , , "=Status" ElseIf c = 0 Then c.Offset(, -9).Validation.Modify xlValidateList = False End If On Error Resume Next Next End Sub

Groetjes Danny. :thumb:

Bedankt voor je hulp het is gelukt met de code.

Groeten,

Boudewijn

Warme bakkertje · 16 apr 2010

Dan zou ik eerder voor deze gaan, omdat je anders met elke celverplaatsing de volledige lus gaat doorlopen

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Offset(, 15) = 1 Then
        Target.Offset(, 6).Validation.Modify xlValidateList, , , "=Status"
    Else
        Target.Offset(, 6).Validation.Modify xlValidateList = False
    End If
End Sub

Wegschrijven van regel naar ander werkblad

Gebruiker

Bijlagen

Terugkerende gebruiker

Terugkerende gebruiker

Bijlagen

Meubilair

Gebruiker

Bijlagen

Terugkerende gebruiker

Bijlagen

Gebruiker

Meubilair

Inventaris

Terugkerende gebruiker

Meubilair

Gebruiker

Bijlagen

Meubilair

Terugkerende gebruiker

Gebruiker

Inventaris

Terugkerende gebruiker

Gebruiker

Meubilair

Wij waarderen jouw privacy