"Dé grootste en gratis computerhelpdesk van Nederland"
-
Privacywetgeving
Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.
Rij kopieren op voorwaarde (VBA)
- Onderwerp starter gvanwijk
- Startdatum
- Status
Iets verder kijken dan je neus lang is wil ook wel helpen. Nog geen dag oud: Zowel met code als draaitabel. https://www.helpmij.nl/forum/showthread.php/949924-Rij-automatisch-verplaatsen-bij-het-zetten-van-het-vinkje-naar-een-andre-werkbald
@ VenA
1.Bij die code wordt de volledige regel verplaatst, niet gekopieerd -> Hoe moet code aangepast worden (vervangen delete -> copy werkt niet)
2. Dat keuzescherm (userform) tussendoor kan vervallen -> welk deel kan weg? Alleen " UserForm1.Show" weghalen dan werkt code niet meer
1.Bij die code wordt de volledige regel verplaatst, niet gekopieerd -> Hoe moet code aangepast worden (vervangen delete -> copy werkt niet)
2. Dat keuzescherm (userform) tussendoor kan vervallen -> welk deel kan weg? Alleen " UserForm1.Show" weghalen dan werkt code niet meer
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Sh.ListObjects(1).DataBodyRange.Columns(18)) Is Nothing And Target.Count = 1 Then
Application.EnableEvents = False
If LCase(Target) = "x" Then
With Sh.ListObjects(1)
ar = Sh.Cells(Target.Row, .Range.Cells(1).Column).Resize(, 18).Value
UserForm1.Show
.ListRows(Target.Row - .Range.Cells(1).Row).Delete
End With
End If
Application.EnableEvents = True
End If
End Sub
Jack Nouws
Terugkerende gebruiker
- Lid geworden
- 16 apr 2008
- Berichten
- 1.396
Met tabellen
Zonder overbodige variabelen en onafhankelijk waar op het werkblad de tabel staat.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
With ListObjects(1)
If Not Intersect(Target, .ListColumns(9).DataBodyRange) Is Nothing And Target.Count = 1 Then
Application.EnableEvents = False
If Target = "Betaald via kas" Then
Sheets("Kasboek").ListObjects(1).ListRows.Add.Range.Resize(, 8) = Cells(Target.Row, .Range.Cells(1).Column).Resize(, 8).Value
.ListRows(Target.Row - .Range.Cells(1).Row).Delete
End If
Application.EnableEvents = True
End If
End With
End Sub
HSV
Inventaris
- Lid geworden
- 18 jul 2008
- Berichten
- 20.316
- Office versie
- Office 365
Zoveel mogelijk in de materie van het listobject geschreven.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
With ListObjects(1)
If Not Intersect(Target, .DataBodyRange.Columns(9)) Is Nothing And Target.Count = 1 Then
Application.EnableEvents = False
If Target = "Betaald via kas" Then
Sheets("Kasboek").ListObjects(1).ListRows.Add.Range.Resize(, 8) = .ListRows(Target.Row - .HeaderRowRange.Row).Range.Value
.ListRows(Target.Row - .HeaderRowRange.Row).Delete
End If
Application.EnableEvents = True
End If
End With
End Sub
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
With ListObjects(1)
If Not Intersect(Target, .DataBodyRange.Columns(9)) Is Nothing And Target.Count = 1 Then
Application.EnableEvents = False
If Target = "Betaald via kas" Then
with .ListRows(Target.Row - .HeaderRowRange.Row)
Sheets("Kasboek").ListObjects(1).ListRows.Add.Range.Resize(, 8) = .Range.Value
.Delete
end with
End If
Application.EnableEvents = True
End If
End With
End Sub- Status
