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

Quote

Weergeven resultaten 1 tot 9 van 9

Onderwerp: Regels uit tabel laten verplaatsen naar ander tabblad

  1. #1
    Junior Member
    Geregistreerd
    26 december 2016
    Vraag is niet opgelost

    Regels uit tabel laten verplaatsen naar ander tabblad

    Dag Iedereen,

    Bijgaand een bestand wat ik heb gemaakt. Voor het voorbeeld heb ik alle gegevens en enkele macro's verwijderd. In principe werkt alles goed maar heb 1 kleine probleem.

    Door middel van enkele knoppen kun je regels uit de tabel verplaatsen naar een ander tabblad . Eigenlijk wordt de regel gekopieerd naar een andere tabblad en wordt de oude regel verwijderd. Dit kun je doen door een willekeurige cel in de regel die verplaatst moet worden te selecteren, en dan op de knop "gereed melden" en "verwijderen" te drukken.

    Zodra er geen filters aan staan in de tabel werkt dit prima. Echter zodra er een filter aan staat van de tabel (dus niet de hele tabel zichtbaar is) werkt het net niet. de te verplaatsen regel wordt wel gekopieerd naar het andere tabblad maar de oude regel wordt niet verwijderd...? Op die manier staat de zelfde regel in twee tabbladen wat niet mag.
    Alle wordt gestuurd middels VBA en heb al aardig wat geprobeerd om dit probleem te verhelpen. De oude regel moet dus verwijdert worden ongeacht of er filters aanstaan in de tabel. Hopelijk weten jullie een mogelijk oplossing?

    Alvast bedankt!
    Bijgevoegde bestanden Bijgevoegde bestanden
    Laatst aangepast door Gerjan87 : 4 december 2019 om 15:16

  2. #2
    Senior Member
    Geregistreerd
    17 juni 2015
    als je in de macro verwijderen copy veranderd in cut?
    Marco

  3. #3
    Junior Member
    Geregistreerd
    26 december 2016
    Helaas werkt dat niet. Was het maar zo makkelijk
    Toch bedankt voor het meedenken.

  4. #4
    Senior Member
    Geregistreerd
    17 juni 2015
    Code:
    'naar colom c t/m R kopieeren
        Range("c" & r, "r" & r).Copy Destination:=Sheets("Afgerond").Range("C" & iRow, "q" & iRow)
        Range("c" & r, "r" & r).ListObject.ListRows(r - 8).Delete
    en als je nu het rode weg haalt?
    of moet de regel ook meteen naar verwijderd als die uit actueel gaat?
    Marco

  5. #5
    Junior Member
    Geregistreerd
    26 december 2016
    Grappig, als je dat stuk code weg haalt doet de marco het inderdaad nog steeds.
    Helaas nog steeds de zelfde fout echter. Zodra er een filter aan staat wordt de regel niet verwijderen. Helaas komt er dan nu ook een foutmelding.

  6. #6
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Misschien eerst eens verdiepen in de werking van tabellen in VBA?

    In de module van Thisworkbook lijkt mij dit voldoende
    Code:
    Private Sub Workbook_Open()
      Sheets("Actueel").ListObjects(1).AutoFilter.ShowAllData
    End Sub
    Voor het verplaatsen en verwijderen kan je het beste ook binnen de tabel blijven. Je krijgt dan zoiets
    Code:
    Sub VenA()
      With ActiveSheet.ListObjects(1)
        If Not Intersect(ActiveCell, .DataBodyRange) Is Nothing Then
          Sheets("Verwijderd").ListObjects(1).ListRows.Add.Range.Resize(, .ListColumns.Count) = .Range.Rows(ActiveCell.Row + 1 - .HeaderRowRange.Row).Resize(, .ListColumns.Count).Value
          Application.DisplayAlerts = False
          .Range.Rows(ActiveCell.Row + 1 - .HeaderRowRange.Row).Delete
          Application.DisplayAlerts = True
        End If
      End With
    End Sub
    In een gefilterde tabel krijg je een melding daarom deze middels DisplayAlerts uitgezet.
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  7. #7
    Giga Honourable Senior Member
    Geregistreerd
    18 juli 2008
    Misschien eerst eens verdiepen in Listrows.

    Vreemde benadering om bij de activecell.row +1 bij te tellen.
    Zonder displayalerts doordat er zo geen melding komt.

    Code:
    Sub hsv()
      With ActiveSheet.ListObjects(1)
        If Not Intersect(ActiveCell, .DataBodyRange) Is Nothing Then
          Sheets("Verwijderd").ListObjects(1).ListRows.Add.Range.Resize(, .ListColumns.Count) = .ListRows(ActiveCell.Row - .HeaderRowRange.Row).Range.Value
          .ListRows(ActiveCell.Row - .HeaderRowRange.Row).Delete
        End If
      End With
    End Sub
    Werkt niet in een gefilterd tabel overigens.

    Dan moet het wel met displayalerts = false
    Code:
    Sub hsv()
      With ActiveSheet.ListObjects(1)
        If Not Intersect(ActiveCell, .DataBodyRange) Is Nothing Then
          Sheets("Verwijderd").ListObjects(1).ListRows.Add.Range.Resize(, .ListColumns.Count) = .ListRows(ActiveCell.Row - .HeaderRowRange.Row).Range.Value
          Application.DisplayAlerts = False
          .ListRows(ActiveCell.Row - .HeaderRowRange.Row).Range.Delete
        End If
      End With
    End Sub
    Laatst aangepast door HSV : 12 december 2019 om 20:17
    ____________
    Met vriendelijke groet,
    Harry

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

  8. #8
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Aha .listrows(x).range
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  9. #9
    Giga Honourable Senior Member
    Geregistreerd
    18 juli 2008
    Omdat de tabellen even groot zijn kan het rode gedeelte er ook wel uit.

    Code:
    Sub hsv()
      With ActiveSheet.ListObjects(1)
        If Not Intersect(ActiveCell, .DataBodyRange) Is Nothing Then
          Sheets("Verwijderd").ListObjects(1).ListRows.Add.Range.Resize(, .ListColumns.Count) = .ListRows(ActiveCell.Row - .HeaderRowRange.Row).Range.Value
          Application.DisplayAlerts = False
          .ListRows(ActiveCell.Row - .HeaderRowRange.Row).Range.Delete
        End If
      End With
    End Sub
    Of nog iets korter.
    Code:
    Sub hsv()
      With ActiveSheet.ListObjects(1)
        If Not Intersect(ActiveCell, .DataBodyRange) Is Nothing Then
          Sheets("Verwijderd").ListObjects(1).ListRows.Add.Range = .ListRows(ActiveCell.Row - .Range.Row).Range.Value
          Application.DisplayAlerts = False 'voor gefilterde rijen.
          .ListRows(ActiveCell.Row - .Range.Row).Range.Delete
        End If
      End With
    End Sub
    Laatst aangepast door HSV : Gisteren om 21:14
    ____________
    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