XL 2010 Message erreur sur script

  • Initiateur de la discussion Initiateur de la discussion sebbbbb
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

sebbbbb

XLDnaute Impliqué
Bonjour

j'utilise le script suivant qui me lance un message d'erreur lorsque activé (je precise aucune feuille n'est protégée)

1570125426442.png


lorsque je clique sur débogage :

1570125491926.png


ci-dessous la totalité du script. Voyez vous la raison du prob svp ?

Sub Ajouter()
ActiveWorkbook.Unprotect ""

Dim TWsh(1 To 12) As Worksheet, N As Long, NomF, Rng As Range, M As Long, NSrc As String, NCbl As String
Set TWsh(1) = ActiveSheet
For N = 2 To 6
Set TWsh(N) = ActiveWorkbook.Worksheets(TWsh(1).Index - 1 + N)
Next N
For N = 7 To 12
TWsh(N - 6).Copy After:=TWsh(N - 1)
Set TWsh(N) = ActiveSheet
NomF = TWsh(N - 6).Name
TWsh(N).Name = Left$(NomF, Len(NomF) - 1) & Right$(NomF, 1) + 1
Next N
For N = 7 To 12
Set Rng = TWsh(N).Cells.SpecialCells(xlCellTypeFormulas, 23)
For M = 1 To 6
' AdrSrc = TWsh(M).[A1].Address(External:=True)
' AdrCbl = TWsh(M + 6).[A1].Address(External:=True)
' AdrSrc = Mid$(AdrSrc, InStr(AdrSrc, "]") + 1): AdrSrc = Left$(AdrSrc, InStr(AdrSrc, "!"))
' AdrCbl = Mid$(AdrCbl, InStr(AdrCbl, "]") + 1): AdrCbl = Left$(AdrCbl, InStr(AdrCbl, "!"))
NSrc = TWsh(M).Name: NCbl = TWsh(M + 6).Name
Rng.Replace What:=NSrc & "!", Replacement:=NCbl & "!", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Rng.Replace What:="'" & NSrc & "'!", Replacement:="'" & NCbl & "'!", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next M, N
TWsh(1).Shapes(Application.Caller).Delete
ActiveSheet("BL impr.1").Select
Range("C5").Select
ActiveWorkbook.Protect ""
End Sub



merci
Seb
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
9
Affichages
385
Réponses
3
Affichages
521
Réponses
2
Affichages
1 K
Réponses
3
Affichages
760
  • Question Question
Microsoft 365 VBA sur outlook
Réponses
14
Affichages
997
Réponses
8
Affichages
906
Retour