meerdere tabbladen in excel aanmaken/kopieëren met VBA adv celwaarde

[Rendo60]

Goedenavond,

Ik wil graag met VBA een loop maken om tabbladen te kopiëren.
In het tabblad "Start" staan in kolom B paragraaf nummers van een checklist.
In kolom F staat een "nee" voor geen verdere actie, en "ja" voor de actie tabblad kopiëren.
Nu wil ik graag dat de loop kopieën maakt van tabblad "leeg blad" van elke "ja", waarbij de naam van het tabblad de cel B is van dezelfde rij.
In het voorbeeld bestand zal hij 2 tabbladen moeten aanmaken (2x "ja") met de naam "1,2" en "1,4"

Onderstaande code ben ik mee bezig geweest, maar kom maar niet verder.

Sub Kopieer()
With Sheets("Start")
For Each ja In .Range("F5:F" & .Cells(Rows.Count, 1).End(xlUp).Row)
Sheets("leeg blad").Copy , Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = ja
Next
End With
End Sub

mvrgr Rendo

 

[HSV]

Met zoiets gaat dat lukken.

Sub Kopieer()
Dim cl As Range
For Each cl In Columns(6).SpecialCells(2)
If LCase(cl) = "ja" And Not Evaluate("isref(" & cl.Offset(, -4) & "!A1)") Then
   Sheets("leeg blad").Copy , Sheets(Sheets.Count)
   ActiveSheet.Name = cl.Offset(, -4)
 End If
Next cl
End Sub

 

[Rendo60]

Goedenavond Harry,

Het werkt op deze manier, maar heb wel wat vraagjes hoe je dit opbouwt als je gegevens op een andere plek hebt staan.
Je geeft aan met "For Each cl In Columns(6).SpecialCells(2)" dat je naar de voorwaarde in kolom 6 wilt kijken, dan wordt de naam van het tabblad de waarde in cel van kolom 2 behorende bij dezelfde rij toch?
Als je wilt kijken naar de cel ernaast in kolom 3 dan wordt het dus "For Each cl In Columns(6).SpecialCells(3)"
maar als ik dat aanpas krijg ik de foutmelding "Fout 1004 tijdens uitvoering:"
Of moet ik dan de Offset veranderen in -3 ( kolom 6 - kolom 3)?

mvrgr Rendo

 

[HSV]

column(6).specialcells(2) betekent: Cellen die constanten bevatten in kolom F → specialcells(xltypeconstants)
Offset(,-4) betekent vier kolommen naar links t.o.v. kolom F.

 

[Rendo60]

Goedemorgen Harry,
Ik heb dit overgebracht naar het werk bestand maar krijg dan de melding "Typen komen niet met elkaar overeen"
Op het werk gebruik ik excel 2013.
In het bestand staan samengevoegde cellen, heeft het daar mee te maken?
Mvrgr Rendo

 

[HSV]

Samengevoegde cellen gevev áltijd problemen vroeg of laat.
Verwijderen dus.
Of het bestand plaatsen zoals het er op je werk uitziet.

 

[Rendo60]

Goedenavond,

Bijgevoegd de nieuwe bijlage waar de foutmelding op komt.
Ik kom er niet uit.

mvrgr Rendo

 

[HSV]

Test het maar eens Rendo.

Sub Kopieer()
Dim cl As Range
With Sheets("start")
  For Each cl In .Range("e19:e" & .Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(2)
        If LCase(cl) = "ja" And Not Evaluate("isref(" & cl.Offset(, -2) & "!A1)") Then
          Sheets("Invoer").Copy , Sheets(Sheets.Count)
          ActiveSheet.Name = cl.Offset(, -2)
        End If
 Next cl
End With
End Sub

 

[Rendo60]

Goedenavond Harry,

Het werkt helemaal super, heel erg bedankt.

mvrgr Rendo

 

[HSV]

Graag gedaan Rendo.

Niet vergeten de vraag nog als opgelost te markeren in je openingspost.
Bvd.