Erreur definie par l'application ou par l'objet

zxzx · 23 Juillet 2012

bonjour,
voilà le code que j'aimerais mettre en place qui doit permettre de créer des onglets en fonction d'une liste de données sur la feuille ("Input"), de créer un lien hypertexte vers cette onglet et enfin de copier/coller la feuille "source" vers les onglets créer

Code:

Sub creationonglet()

Dim i As Integer
Dim onglet As Worksheet

For i = 1 To Range("A65536").End(xlUp).Row

'1er partie
    If Not IsEmpty(Cells(i, 1)) Then
        If Not exist_f(Cells(i, 1)) Then
            Set onglet = Sheets.Add(After:=Sheets(Sheets.Count))
            onglet.Name = Cells(i, 1).Value
            Sheets("Input").Activate
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", SubAddress:= _
                Cells(i, 1).Value & "!A1", TextToDisplay:=Cells(i, 1).Value

 '2eme partie
            Sheets("Source").Select
            Cells.Select
            Selection.Copy
            Sheets(Cells(i, 1).Value).Select
            Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            Range("A1").Select
            
        End If
    End If
Next
End Sub

Function exist_f(feuille)
For Each sh In Sheets
  If sh.Name = feuille Then
    exist_f = True
    Exit Function
  End If
Next
exist_f = False
End Function

quand je lance le programme j'ai l'erreur comme indiqué dans le titre.
je pense que l'erreur vient du fait que la première partie du code ne marche que quand celui ci se trouve écrit dans une feuille et la deuxième ne marche que quand le code est écrit dans un module.

donc j'aimerais savoir comment modifier le code pour que celui ci marche dans un module.

merci d'avance

Cousinhub · 23 Juillet 2012

Re : Erreur definie par l'application ou par l'objet

Bonjour,

Je pense que le problème vient de cette ligne :

Code:

onglet.Name = Cells(i, 1).Value

Comme tu as créé un nouvel onglet, on est donc sur cet onglet.
Or, la valeur de la cellule Cells(i,1) est nulle, donc on ne peut pas renommer cet onglet...

Je te propose cette variante, à insérer dans un module :

Code:

Sub creationonglet()
Dim Cel As Range
Dim Onglet As Worksheet, FInput As Worksheet
Application.ScreenUpdating = False
Set FInput = Sheets("Input")
With FInput
    For Each Cel In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
'1er partie
        If Not IsEmpty(Cel) Then
            If Not exist_f(Cel.Value) Then
                Set Onglet = Sheets.Add(After:=Sheets(Sheets.Count))
                Onglet.Name = Cel.Value
                .Hyperlinks.Add Anchor:=Cel, Address:="", SubAddress:= _
                Cel.Value & "!A1", TextToDisplay:=Cel.Value
 '2eme partie
                Sheets("Source").Cells.Copy
                Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                Range("A1").Select
            End If
        End If
    Next
End With
End Sub

Function exist_f(feuille)
For Each sh In Sheets
  If sh.Name = feuille Then
    exist_f = True
    Exit Function
  End If
Next
exist_f = False
End Function

Bon courage

zxzx · 23 Juillet 2012

Re : Erreur definie par l'application ou par l'objet

merci beaucoup pour la modification et la rapidité, le programme marche bien

Erreur definie par l'application ou par l'objet

zxzx

XLDnaute Nouveau

Cousinhub

XLDnaute Barbatruc

zxzx

XLDnaute Nouveau

Discussions similaires