Probleem macro - automatisch sheets aanmaken

[LuukH94]

Allen,

Ik heb een macro opgesteld voor het automatisch creëren van een sheet als ik een cel invul, waarbij deze tevens een bepaald template hanteert. De macro is als volgt:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Count = 1 And Target <> "" Then
  If IsError(Evaluate("'" & Target & "'!A1")) Then
    Sheets("std").Copy , Sheets(Sheets.Count)
    With ActiveSheet
      .Name = Target
      .[C5] = Target
    End With
  End If
End If
End Sub

Nu komt het regelmatig voor dat ik niet één cel invul, maar er meerdere tegelijk kopieer en plak. Dit trekt de macro niet, gezien er 'target.count = 1' is aangevoerd. Heeft iemand enig idee hoe ik dit wel mogelijk maak?

Het lukt me niet om een voorbeeld up-te-loaden, omdat ik een foutmelding over een VB verhaal krijg.... EDIT: toch gelukt.

Alvast bedankt.

Luuk

 

[snb]

zie: https://www.helpmij.nl/forum/announcement.php?f=5

 

[LuukH94]

Ik heb mijn bericht aangepast nav de handleiding!

 

[HSV]

Bv.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
 for each cl in target.cells
   If IsError(Evaluate("'" & cl & "'!A1")) and cl <> "" Then
    Sheets("std").Copy , Sheets(Sheets.Count)
      With ActiveSheet
       .Name = cl
       .[C5] = cl
      End With
  End If
 next cl
End If
End Sub

 

[LuukH94]

Dank voor je reactie, HSV. Helaas krijg ik bij het aanvoeren van deze macro, de foutmelding: Ongeldig. Buiten procedure. Ik heb gisteren een andere macro 'in elkaar geflanst', welke voor 90% werkt. Hij werkt als ik meerdere cellen kopieer en plak, echter als ik hierna nog één cel toevoeg (typ), dan doet hij dit niet. De macro is als volgt:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim CellCount As Integer
CellCount = Target.Count

Dim cel As Range
Dim selectedRange As Range

Set selectedRange = Application.Selection


If Target.Column = 1 And CellCount >= 1 Then
    For Each cel In selectedRange.Cells
        If IsError(Evaluate("'" & cel.Value & "'!A1")) Then
            Sheets("std").Copy , Sheets(Sheets.Count)
            With ActiveSheet
            .Name = cel.Value
            .[C3] = cel.Value
            End With
        End If
    Next cel
End If
End Sub

 

[HSV]

Laat die buitenprocedure eens zien in je voorbeeldbestand met mijn code en wat je zoal doet om dit te laten gebeuren.

 

[LuukH94]

Dank voor de reacties. Ik heb inmiddels zelf een oplossing gevonden door wat te lezen in Excel boeken die ik nog had liggen. Uiteindelijk is dit 'm geworden:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CellCount As Integer
    CellCount = Target.Count
    
    Dim cel As Range
    Dim selectedRange As Range
    
    Select Case CellCount
        Case 1:     Set selectedRange = Target
        Case Else:  Set selectedRange = Application.Selection
    End Select
    
    If Target.Column = 1 Then
        For Each cel In selectedRange.Cells
            If cel <> "" Then
                If IsError(Evaluate("'" & cel.Value & "'!A1")) Then
                    Sheets("std").Copy , Sheets(Sheets.Count)
                    With ActiveSheet
                    .Name = cel.Value
                    .[C3] = cel.Value
                    End With
                End If
            End If
        Next cel
    End If
End Sub

 

[HSV]

Prima, maar die van mij werkt hier uitstekend.