Helpmij.nl
Helpmij.nl
Helpmij.nl
Steun Helpmij.nl! Klik hier     Computerprobleem? Klik hier!

Quote

Weergeven resultaten 1 tot 10 van 10

Onderwerp: Rij kopieren op voorwaarde (VBA)

  1. #1
    Vraag is opgelost

    Rij kopieren op voorwaarde (VBA)

    Ik wil graag een rij kopieren:
    1. op een voorwaarde (zie bijlage)
    2. naar de 1e vrije regel
    3. van een ander tabblad

    Zie voorbeeld. Welke VBA werkt hiervoor?
    Bijgevoegde bestanden Bijgevoegde bestanden

  2. #2
    Mega Honourable Senior Member popipipo's avatar
    Geregistreerd
    21 november 2006
    Ik zou liever gebruik maken van een draaitabel
    Bijgevoegde bestanden Bijgevoegde bestanden
    Willem

    25 % van de oplossing is het juist formuleren van de vraag.
    25 % van de oplossing is het juist lezen van de vraag.
    25 % van de oplossing is het xls voorbeeldje bij de vraag.
    25 % van de oplossing is het antwoord op de vraag.

  3. #3
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    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/showthr...andre-werkbald
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  4. #4
    @ 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

    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

  5. #5
    Als je geen tabellen gebruikt kan dit ook.
    Bijgevoegde bestanden Bijgevoegde bestanden

  6. #6
    Yesss Dat is precies de oplossing voor de vraag die ik stelde! Fijn, bedankt Emields!

  7. #7
    Mega Senior Jack Nouws's avatar
    Geregistreerd
    16 april 2008
    Locatie
    Zundert
    Afstand tot server
    ±150 km
    Met tabellen
    Bijgevoegde bestanden Bijgevoegde bestanden
    Wees gelukkig met wat je hebt in plaats van ongelukkig door wat je ontbreekt

  8. #8
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    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
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  9. #9
    verwijder de volgende regel uit de code van VenA, die regel is bedoeld om in de "oude" lijst de gegevens te verwijderen en ik den dat ze moeten blijven staan.

    Code:
    .ListRows(Target.Row - .Range.Cells(1).Row).Delete

  10. #10
    Giga Honourable Senior Member
    Geregistreerd
    18 juli 2008
    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
    ____________
    Met vriendelijke groet,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl en business

Partners
Sponsoren