Rijen verplaatsen naar ander werkblad om bepaalde waarde

[Robbertdekeijzer]

Goedemiddag,

Ik heb een bestand waarin jaartallen staan vermeld, 2016, 2017 tot en met 2021. Ik wil dat als Kolom E deze waarde heeft deze naar naar mijn andere werkblad verplaatst wordt. Werkblad 2016, 2017 tot en met 2021. Het liefst moet dan de gehele rij ook worden verwijderd uit werkblad 1. Per jaartal kan het Q1 2017, Q2 2017, Q3 2017 en Q4 2017 bevatten en wil ik graag dat alles met 2017 uit kolom E wordt verplaatst naar het werkblad.

Zou iemand mij daarbij kunnen helpen? Ik heb tot nu toe onderstaande maar werkt nog niet naar behoren. Moet ik daarbij voor elke criteria Q1 etc. een aparte module schrijven?

Dim rij As Long 
Dim n As Long 
Dim src As Worksheet 
Dim trg As Worksheet 
Set src = Sheets("Blad1") 
Set trg = Sheets("Blad2") 
Application.ScreenUpdating = False 
rij = trg.[A65536].End(xlUp).Row + 1 

For n = 1 To Blad1.[A65536].End(xlUp).Row 
If Cells(n, "E").Value = "Q1 2017" Then 
Range(Cells(n, "A"), Cells(n, "H")).Copy 
trg.Cells(rij, "A").PasteSpecial 
Range(Cells(n, "A"), Cells(n, "H")).EntireRow.Delete 

rij = rij + 1 
End If 
Next 
Application.Goto [blad2!A1], True 
Application.Goto [blad1!A1], True 
Application.ScreenUpdating = True [ATTACH]296031.vB[/ATTACH]
End Sub

 

[gast0660]

Hoi welkom op het forum.
Maar:
Plaats je code tussen code tags (# knop).
en post een duidelijk vb bestandje.
Dan wordt je sneller geholpen.

 

[Robbertdekeijzer]

Ah dankjewel!

Hierbij het voorbeeld. Het is de bedoeling dus dat zodra iemand Q1 t/m Q4 2017 invult dat deze dan naar t werkblad van 2017 gaat.

Zie voorbeeld:

Bekijk bijlage 296033

 

[gast0660]

Er is iets misgegaan met uw bijlage
Ga geavanceerd en gebruik de paperclip

 

[VenA]

Probeer het zo eens.

Sub VenA()
With Sheets("Werkmap").Cells(1).CurrentRegion
  For j = 2016 To 2021
    .AutoFilter 5, "*" & j
    .Offset(1).Copy Sheets(CStr(j)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
  Next j
  .AutoFilter
  .Offset(1).ClearContents
End With
End Sub

 

[Robbertdekeijzer]

Voorbeeld

Bijgaand het voorbeeld. Hopelijk is het zo duidelijker

Bekijk bijlage voorbeeld helpmij.xlsx

 

[Robbertdekeijzer]

Ik ben zelf wat minder bekend met het programma dus voor mij is het erg lastig. Zodra ik de code van VenA gebruik dan heb ik in mijn werkmap geen gegevens meer staan als ik deze uitvoer.
Ik hoopte dat de code wat makkelijker zou zijn en deze een aantal keer kan kopieren voor de andere criteria ( Q1 2017 t/m Q4 2021).

Is het uberhaupt mogelijk om op deze manier de cellen te laten verplaatsen met VBA?

 

[VenA]

Wat is nu de bedoeling? Je wilt de gegevens verplaatsen naar de tabjes met de juiste jaartallen en het orginele blad moet wel/niet leeggemaakt worden?

 

[Robbertdekeijzer]

Ik heb een grote lijst met gegevens inderdaad en met verschillende jaartallen die te vinden zijn in kolom E.
Het is inderdaad de bedoeling dat ze uit de werkmap verdwijnen en in de tabbladen 2016, 2017 etc. terecht komen.

Alleen toen ik uw code ging uitvoeren verdwenen de gegevens uit de werkmap alleen waren ze ook niet in de juiste mappen te vinden.
Ik weet niet of ik nog andere gegevens moet toevoegen in uw code.

Vul ze in bij de module in vb en F5, vergeet ik wellicht iets? Het vervelende is dat ze ook nog per jaar in Q1, Q2, Q3 en Q4 verdeeld zijn.

 

[VenA]

Werkt prima in het voorbeeldbestandje.

 

[Robbertdekeijzer]

Top, in t voorbeeld werkte hij inderdaad.
Ik zag alleen nu dat ik niet het juiste voorbeeld had ingestuurd en vandaar dat hij in mijn bestand niet goed werkt.

Het is nu al zo dat er gegevens in de tabbladen staan en als ik nieuwe gegevens binnenkrijg wil ik die eerst in mag (nieuwe gegevens kopieren en vervolgens de code laten uitvoeren.

Daarnaast ontbreekt er soms ook nog een datum en die wil ik graag in het laatste mapje verwerkt hebben. Excuus maar ik kom er niet uit helaas.

Bijgaand nog een keer het juiste voorbeeld. Bekijk bijlage nieuw voorbeeld helpmij.xlsx

 

[VenA]

Het is nu al zo dat er gegevens in de tabbladen staan en als ik nieuwe gegevens binnenkrijg wil ik die eerst in mag (nieuwe gegevens kopieren en vervolgens de code laten uitvoeren.

Wat staat hier?

 

[Robbertdekeijzer]

Wat staat hier?

Ik bedoel dat ik nu in de mappen 2016, 2017,2018 t/m 2021 al veel gegevens heb staan. Per jaar(map) staan daar ongeveer 100 mensen in.
Vervolgens krijg ik een nieuw excelbestand binnen met gegevens van verschillende mensen. Deze gegevens kopieer ik dan naar het tabblad 'nieuwe gegevens'. Dan staan alle jaartallen(van de nieuwe gegevens) nog door elkaar heen.

Ik zou dan graag dan weer de nieuwe gegevens willen verwerken zodat ze bij het juiste jaar(map) terechtkomen.

Ik hoop dat dit iets duidelijker is

 

[VenA]

Dat gebeurt nu toch? Of moeten eerst de oude gegeven uit de 'jaar' tabjes verwijderd worden?

 

[Robbertdekeijzer]

Dat klopt, ik wil het liefst dat de nieuwe gegevens gewoon onder de andere gegevens komen bij het juiste jaartal.

Alleen als ik de code nu uitvoer dan verdwijnen de gegevens in de map (nieuwe gegevens) maar kan ik ze niet terugvinden bij de mappen met jaartallen.
En mensen die geen jaar hebben ingevuld zou ik dan het liefst in de map(datum onbekend) willen zien. bijgaand een foto van de code die ik heb ingevoerd.

 

[VenA]

Wat denk je dat deze regel doet?

.Offset(1).Copy Sheets(CStr(j)).Cells(Rows.Count, 1).End(xlUp).Offset(1)

Edit.
Je hebt de perioden in jouw nieuwe bestand in kolom D staan. Dan moet je het filter natuurlijk ook aanpassen.

.Autofilter [COLOR="#FF0000"]4[/COLOR]

 

[Robbertdekeijzer]

Wat denk je dat deze regel doet?

.Offset(1).Copy Sheets(CStr(j)).Cells(Rows.Count, 1).End(xlUp).Offset(1)

Edit.
Je hebt de perioden in jouw nieuwe bestand in kolom D staan. Dan moet je het filter natuurlijk ook aanpassen.

.Autofilter [COLOR="#FF0000"]4[/COLOR]

Onwijs bedankt! Het is gelukt, heel erg blij mee!

Ik heb alleen nog 1 ding, de mensen die geen jaartal hebben ingevoerd verdwijnen helaas uit de lijst als ik de code uitvoer.
Heeft u daarvoor wellicht nog een oplossing?

 

[VenA]

Nu worden ze verplaatst naar het blad 'Datum onbekend'

Sub VenA()
With Sheets("Nieuwe gegevens").Cells(1).CurrentRegion
  For j = 2016 To 2021
    .AutoFilter 4, "*" & j
    .Offset(1).Copy Sheets(CStr(j)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
  Next j
  .AutoFilter 4, "="
  .Offset(1).Copy Sheets("Datum onbekend").Cells(Rows.Count, 1).End(xlUp).Offset(1)
  .AutoFilter
  .Offset(1).ClearContents
End With
End Sub

 

[Robbertdekeijzer]

Fantastisch, bedankt!