Bonjour,
J'ai déjà un fichier excel avec des macro (peut être pas les meilleurs...) mais ça marche. Mais même si le résultat est bon, il m'affiche "Erreur d'execution 9" et je ne comprend pas pourquoi ...
Merci d'avance pour l'aide que vous pourriez m'apporter.
Voici les codes :
NB2: Je cherche aussi une façon de pouvoir créer automatiquement un lien hypertext qui en cliquant sur le nom dans la première feuille, me renvoie à la feuille du nom correspondant.
J'ai déjà un fichier excel avec des macro (peut être pas les meilleurs...) mais ça marche. Mais même si le résultat est bon, il m'affiche "Erreur d'execution 9" et je ne comprend pas pourquoi ...
Merci d'avance pour l'aide que vous pourriez m'apporter.
Voici les codes :
Code:
Option Explicit
Dim maColonne As Integer
Sub SupprimeFeuille()
Range("K5:K12510").Select
Selection.ClearContents
Range("A1").Select
Dim Compteur As Integer, Nom As String
Application.DisplayAlerts = False
For Compteur = Worksheets.Count To 1 Step -1
Nom = Sheets(Compteur).Name
Select Case Nom
Case "Pays", "model"
Case Else
Sheets(Compteur).Delete
End Select
Next Compteur
Application.DisplayAlerts = True
End Sub
Sub AjoutFeuilles()
Dim derLi As Long
Dim i As Integer
Dim maFeuille As Worksheet
Set maFeuille = ActiveSheet
maColonne = 5 ' a ajuster
derLi = Columns(maColonne).Find("*", , , , , xlPrevious).Row
For i = 5 To derLi ' 2 si ligne de titre
'Si la feuille existe déjà, on passe à la ligne suivante
If FeuilleExiste(maFeuille.Cells(i, maColonne)) Then GoTo Suivant
' ajout d'une feuille à la fin
Sheets(2).Copy after:=Sheets(Worksheets.Count)
' nom de la feuille = valeur de la cellule
Sheets(Worksheets.Count).Name = maFeuille.Cells(i, maColonne)
Sheets(Worksheets.Count).Cells(1, 4) = maFeuille.Cells(i, 3)
Suivant:
Next
'on retourne à la feuille d'origine
maFeuille.Select
Set maFeuille = Nothing
End Sub
Sub Bonus()
Dim derLi As Long
Dim k As Integer
Dim maColonne As Integer
maColonne = 5 ' a ajuster
derLi = Columns(maColonne).Find("*", , , , , xlPrevious).Row
For k = 3 To derLi + 3
Sheets(k).Select
Range("F57").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Pays").Select
Cells(k + 2, 11).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next
End Sub
Sub Supprimer_tout()
Range("A2:K12510").Select
Selection.ClearContents
Range("A1").Select
End Sub
Function FeuilleExiste(Nom$) As Boolean 'Ti
On Error Resume Next
FeuilleExiste = Sheets(Nom).Name <> ""
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = maColonne Then AjoutFeuilles
End Sub
NB2: Je cherche aussi une façon de pouvoir créer automatiquement un lien hypertext qui en cliquant sur le nom dans la première feuille, me renvoie à la feuille du nom correspondant.