rij verplaatsen naar ander tablad afhankelijk van 2 celwaarden

[Scav]

Goedemorgen allemaal,

Ik heb gisteren getracht een vraag te stellen in een reeds behandelde vraag, omdat deze vrijwel naadloos aansloot op hetgeen waarnaar ik op zoek was. Helaas is het topic gisteren op slot gedaan, vandaar dat ik hem nu als nieuwe vraag indien.

Onder het motto beter goed gepikt dan slecht bedacht heb ik het actiepuntenlijst bestand http://www.helpmij.nl/forum/attachment.php?attachmentid=68153&d=1249413678 aangepast aan mijn eigen behoeften. Ik zou echter graag een aanpassing in de VB doen, maar kom hier niet uit.

mijn aangepaste sub:

Sub Afgerond()
    Application.ScreenUpdating = False
   Dim c As Range
  [COLOR="#0000CD"] Dim d As Range[/COLOR]
   
   For Each c In [K5:K1000]
[COLOR="#0000CD"]   For Each d In [J5:J1000][/COLOR]
[COLOR="#0000CD"]        If c = "Afgerond" And d = "Adriaan" Then
            c.Rows.EntireRow.Copy
            
           ['Adriaan'!A65536].End(xlUp).Offset(1, 0).Insert Shift:=xlDown
            
        End If

5x herhaald met verschillende namen en bladen, daarna:[/COLOR]

    Next
   
    With Application
    
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    For Each c In [K1:K1000]
    If c = "Afgerond" Then
    c.Rows.EntireRow.Delete '(xlUp)
    End If
    Next
End Sub

echter als hij het uitvoerd krijg ik de volgende melding: Besturingsvariabele For is al in gebruik (geeft fout aan in het slot deel bij de "For each" direct na "End With"

mijn vraag is dan ook, hoe laat ik het script naar 2 variabelen kijken?

Voor de helderheid heb ik mijn toevoegingen aan het script gemarkeerd:

zonder deze toevoeging werkt het script prima, echter dan komen alle dossiers met de status `Afgerond` op 1 blad terecht, terwijl ik ze graag uitgesplitst zou zien naar behandelaar

Alvast bedankt voor de moeite van het lezen en meedenken ;-)

 

[ExcelAmateur]

Scav,

Als je 3x For gebruikt moet je ook 3x Next gebruiken.
Kijk of het nu wel goed werkt.

Sub Afgerond()
    Application.ScreenUpdating = False
   Dim c As Range
   Dim d As Range
   
   For Each c In [K5:K1000]
     For Each d In [J5:J1000]
        If c = "Afgerond" And d = "Adriaan" Then
            c.Rows.EntireRow.Copy
           ['Adriaan'!A65536].End(xlUp).Offset(1, 0).Insert Shift:=xlDown
        End If
     [COLOR="#FF0000"]Next[/COLOR]
5x herhaald met verschillende namen en bladen, daarna:

    Next
   
    With Application
    
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    For Each c In [K1:K1000]
    If c = "Afgerond" Then
    c.Rows.EntireRow.Delete '(xlUp)
    End If
    Next
End Sub

 

[Roncancio]

10 * een For...Next (5 namen met elk 2 For...Next) lijkt mij iets teveel.
Eentje is al voldoende.

Sub verplaatsen()
Dim iNaam As Integer
Dim sNaam As String
    Application.ScreenUpdating = False
    On Error Resume Next
    Range("A1:IV1000").AutoFilter 11, "Afgerond"
    For iNaam = 1 To 5
        sNaam = WorksheetFunction.Choose(iNaam, "Jan", "Piet", "Kees", "Wim", "Adriaan")
        Range("A1:IV1").AutoFilter 10, sNaam
        Range("A2:IV1000").SpecialCells(12).Copy Worksheets(sNaam).Range("A2")
        Range("A2:IV1000").SpecialCells(12).ClearContents
        Range("A1:IV1").AutoFilter
        Range("A2:IV1000").Sort key1:=Range("J2")
    Next
End Sub

Met vriendelijke groet,


Roncancio

 

[Scav]

Hartelijk dank voor de reactie, echter het werkt nog niet helemaal naar behoren.

Ik heb de optie van Roncancio doorgevoerd omdat er 10x for each hanteren inderdaad niet de meest fraaie optie is.
De optie van Roncancio verplaatst keurig de regels naar de correcte pagina's, maar niet helemaal zoals bedoeld:

De dossiers van "Adriaan" die als eerste gedefinieerd is, worden keurig gesplitst, oftewel een dossier met de status "Afgerond" wordt verplaatst naar blad "Adriaan" en de dossiers met status Open blijven staan.

De dossiers die op naam van de overige behandelaars (2 tot 6) staan worden echter allemaal verplaatst naar het tabblad van de behandelaar, ongeacht status.

een bijkomend probleem is dat de regels op de tabbladen van de behandelaars worden overschreven, i.p.v. toegevoegd. oftewel vandaag voer ik het script uit en worden de afgehandelde dossiers verplaatst naar het juiste tabblad. morgen werk ik de voorraad bij en voer ik het script weer uit om een helder beeld te krijgen van de openstaande voorraad dossiers. als ik dan naar het tabblad van de behandelaar ga zijn echter de eerder afgehandelde dossiers overschreven.

Volledigheidshalve de code:

aantekeningen bij de code:

De eerste rij met dossiergegevens is rij 5
Kolom A tot I bevat de dossier gegevens
Kolom J bevat de behandelaar
Kolom K bevat de status (open of afgerond)
Er worden max 1000 rijen gebruikt

Sub Afgerond()
Dim iNaam As Integer
Dim sNaam As String
    Application.ScreenUpdating = False
    On Error Resume Next
    Range("K1:K1000").AutoFilter 11, "Afgerond"
    For iNaam = 1 To 6
        sNaam = WorksheetFunction.Choose(iNaam, "Adriaan", "Arjan", "Brigitte", "Ly-en Tshing", "Rene", "Sandra")
        Range("J5").AutoFilter 10, sNaam
        Range("A5:IV1000").SpecialCells(12).Copy Worksheets(sNaam).Range("A5")
        Range("A5:IV1000").SpecialCells(12).ClearContents
        Range("A5:IV1").AutoFilter
        Range("A5:IV1000").Sort key1:=Range("J5")
    Next
End Sub

Vermoedelijk zie ik iets over het hoofd

 

[Roncancio]

Sub Afgerond()
Dim iNaam As Integer
Dim sNaam As String
    Application.ScreenUpdating = False
    On Error Resume Next
    ActiveSheet.ShowAllData
    Range("A5:K1000").AutoFilter 11, "Afgerond"
    For iNaam = 1 To 6
        sNaam = WorksheetFunction.Choose(iNaam, "Adriaan", "Arjan", "Brigitte", "Ly-en Tshing", "Rene", "Sandra")
        Range("J5").AutoFilter 10, sNaam
        Range("A5:IV1000").SpecialCells(12).Copy Worksheets(sNaam).Range("A5")
        Range("6:1000").SpecialCells(12).Delete
    Next
End Sub

Met vriendelijke groet,


Roncancio

 

[Scav]

I.v.m. een korte vakantie kon ik helaas niet eerder kunnen reageren, echter nu dan toch...

Hartelijk dank voor de input, zeer gewaardeerd. Bestand werkt met de laatste aanpassing zoals beoogd! Super!

Wat mij betreft kan de vraag hiermee worden afgesloten.