Foutmelding 1004 tijdens uitvoering (Door de toepassing of door object gedefinieerde

[Sidea]

Hallo allemaal,

Ik heb een stuk vba-code die ervoor moet zorgen dat er tabbladen ingevoegd gaan worden met als naam bepaalde nummers in een bepaalde kolom op het tabblad Instellingen.

de code die ik gebruik ziet er als volgt uit:

Sub lus()
Dim i As Integer
Dim x As Integer
Dim cl As Variant
x = Range("D1")
 Application.EnableEvents = False
    For i = 1 To x
            With Sheets("Instellingen")
                For Each cl In .Range("B1:B100" & .Cells(Rows.Count, 1).End(xlUp).Row)
                If Not WSExists(CStr(cl)) Then
                Sheets("10000 (1)").Copy , Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = cl
                End If
                Next
            End With
    Next
End Sub

Nu krijg ik de foutmelding: Fout 1004 tijdens uitvoering
Door de toepssing of door object gedefinieerde fout

Nu heb ik al het internet en het forum afgestruind om een oplossing te zoeken, maar kom er nog niet helemaal uit.

Wie kan mij een zetje in de goede richting geven?

Casper

 

[gast0660]

Eerste gok, maar zonder vb bestandje???

Sub lus()
Dim i As Integer
Dim x As Integer
Dim cl As Variant
x = Range("D1")
 Application.EnableEvents = False
    For i = 1 To x
            With Sheets("Instellingen")
                For Each cl In .Range("B1:B100" & .Cells(Rows.Count, 1).End(xlUp).Row)
                If Not WSExists(CStr(cl)) Then
                Sheets("10000 (1)").Copy , Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = cl
                End If
                Next
            End With
    Next
[COLOR="#FF0000"]Application.EnableEvents = True[/COLOR]
End Sub

 

[Sidea]

Hi gast0660,

Helaas helpt dat (nog) niet.

Als ik in de editor kijk, blijft hij 'hangen' op de regel:

Sheets(Sheets.Count).Name = cl

Er wordt dan een tabblad aangemaakt met de naam 10000 (2)

Groet,

Casper

 

[E v R]

Waarom die dubbele lus?

cl zal wel leeg zijn

 

[VenA]

Deze lijkt mij niet logisch

For Each cl In .Range("B1:B100" & .Cells(Rows.Count, 1).End(xlUp).Row)

Bedoel je niet

For Each cl In .Range("B1:B & .Cells(Rows.Count, 2).End(xlUp).Row)

Bestaat deze functie wel in jouw bestand?

WSExists

 

[Sidea]

Hi VenA

ik heb de fuctie zo gedefinieerd:

Function WSExists(wsName As String) As Boolean
    On Error Resume Next
    WSExists = Worksheets(wsName).Name = wsName
End Function

Toch blijft hij op dezelfde regel hangen

Groet,

Casper

 

[Sidea]

Hi Eric,

Ik wil de lus bijvoorbeeld 3 keer uitvoeren omdat er 3 verschillende waarde in kolom B van het tabblad Instellingen staan.

Als dat simpeler kan, hoor ik dat graag

Groet,

Casper

 

[VenA]

Probeer het zo eens.

Sub VenA()
Dim cl As String
For Each cl In Sheets("Instellingen").Columns(2).SpecialCells(2)
    If IsError(Evaluate("'" & cl & "'!A1")) Then
        Sheets("10000 (1)").Copy , Sheets(Sheets.Count)
        ActiveSheet.Name = cl
    End If
Next cl
End Sub

 

[Sidea]

Ga ik straks proberen. Alvast bedankt.

 

[edmoor]

En wijzig je functie:

Function WSExists(wsName As String) As Boolean
    On [COLOR="#FF0000"]Local[/COLOR] Error Resume Next
    WSExists = Worksheets(wsName).Name = wsName
End Function

Maar VenA doet de juiste controle zonder extra functie al.

 

[Sidea]

Bedankt voor alle reacties, maar helaas werkt het nog niet helemaal.
Er komt nu een foutmelding dat er geen cellen gevonden zijn.

Aangezien ik geen haar meer heb, kan ik niet met mijn handen in het haar, anders zou ik het onmiddellijk gedaan hebben.

Ik stuur een test bestandje mee, misschien zie ik iets heel makkelijks over het hoofd

 

[VenA]

Probeer deze eens.

Sub VenA()
Dim cl As String
For Each cl In Sheets("Instellingen").Columns(2).SpecialCells(-4123)
    If cl <> "" And IsError(Evaluate("'" & cl & "'!A1")) Then
        Sheets("10000 (1)").Copy , Sheets(Sheets.Count)
        ActiveSheet.Name = cl
    End If
Next cl
End Sub

 

[Sidea]

Toppie, ik moest alleen cl declareren als variant, maar nu werkt het perfect.

Dank jullie wel :thumb:

Ik zet deze toppic op afgesloten

 

[snb]

Mij lijkt blad 'instellingen' hiervoor overbodig.
Gebruik de gegevens in blad 'origineel'

Sub M_snb()
  sn = Blad2.cells(4, 1).CurrentRegion.Columns(1).SpecialCells(2, 2)
  
  For j = 2 To UBound(sn)
     If Not Evaluate("isref(" & sn(j, 1) & "!A1)") Then Sheets.Add.Name = sn(j, 1)
  Next
End Sub

 

[Sidea]

Hi snb,

Dank voor je reactie, echter niet alle verschillende nummers moeten worden gekopieerd. Daarnaast moet er een kopie van een format per klant komen. Mijn bedoeling is dat het origineel er periodiek in geplakt kan worden, en dat ze met de klant specifieke tabbladen aan het werk kunnen.

 

[snb]

Is voor mij abacadabra.