VBA: for__each: loop werkt niet

[sandra1978]

Hallo,

Ik wil dmv VBA: telkens een nieuw document aanmaken op basis een lijst binnen een bepaald bereik, dit lukt.
Dan wil ik elke lijn kopieren waarvan een bepaalde cel overeenkomt met een item uit de lijst van het bereik. Dit lukt, maar er wordt maar 1 lijn gekopieerd. Als ik met F8 door de code ga, gaat hij na de 'end if', ineens naar de volgende 'next' en gaat hij dus niet door de loop.
Ik heb me er al blind op gestaard, maar zie het niet.

Het straffe is dat ik enkele weken geleden hier ook mee bezig was, en toen lukte het wel (maar ik heb het even moeten laten liggen, en volgens mij niets aangepast...).

Wie helpt me uit de nood?

Sub McrFilterOpOpleiding()
    Dim BronMap As Workbook
    Dim DoelMap As Workbook
    Dim combiRooster As Variant
    Dim combibereik As Variant
          
    Set BronMap = Workbooks("uurrooster_vba test.xlsx")

    For Each combibereik In BronMap.Worksheets("bereiken").Range(Range("ad2"), Range("ad1").End(xlDown))
              Set DoelMap = Workbooks.Add
              DoelMap.SaveAs (combibereik.Value)
                              For Each combiRooster In BronMap.Worksheets("rooster").Range(BronMap.Worksheets("rooster").Range("p5"), BronMap.Worksheets("rooster").Range("p4").End(xlDown))
                                    If LCase(combiRooster.Value) = LCase(combibereik.Value) Then
                                         combiRooster.EntireRow.Copy DoelMap.Sheets("blad1").Range("a1000000").End(xlUp).Offset(1, 0) '"a" & DoelMap.Sheets("blad1").Rows.Count).End(xlUp).Offset(1, 0)
                                    End If
                              Next
    Next
    End Sub

Bekijk bijlage uurrooster_vba test.xlsx

thanks

 

[cow18]

straks is je bronmap geen *.xslx meer, maar een *.xslm, dus kan je die bronmap maar beter gewoon als Thisworkbook aanspreken.
Verder kan je beter gewoon een filter toepassen ipv. die 2e for ... next loop en misschien ook die doelmap sluiten.

Sub McrFilterOpOpleiding()
    Dim BronMap As Workbook
    Dim DoelMap As Workbook
    Dim combiRooster As Variant
    Dim combibereik As Variant

    Set BronMap = Workbooks("uurrooster_vba test.xlsx")
    With BronMap.Worksheets("bereiken")
        Set c = .Range(.Range("ad2"), .Range("ad1").End(xlDown))
    End With
    
    For Each combibereik In c.Cells
        Set DoelMap = Workbooks.Add
        DoelMap.SaveAs (combibereik.Value)
        For Each combiRooster In BronMap.Worksheets("rooster").Range(BronMap.Worksheets("rooster").Range("p5"), BronMap.Worksheets("rooster").Range("p4").End(xlDown))
            If LCase(combiRooster.Value) = LCase(combibereik.Value) Then
                combiRooster.EntireRow.Copy DoelMap.Sheets("blad1").Range("a1000000").End(xlUp).Offset(1, 0)    '"a" & DoelMap.Sheets("blad1").Rows.Count).End(xlUp).Offset(1, 0)
            End If
        Next
    Next
End Sub