Bonjour le Forum,
tout d'abord mes meilleurs voeux pour l'année nouvelle.
Bon voici mon problème,
j'ai cette macro
Dim NomFeuille As String
Dim Ligne As Integer
'Récupération du nome de la nouvelle feuille
NomFeuille = Range("E2")
'Teste si elle existe déjà.
If FeuilleExiste(NomFeuille) Then
'Si oui, demander s'il faut la remplacer
If MsgBox("La feuille '" & NomFeuille & "' existe déjà!" & vbCrLf & _
"voulez-vous la remplacer?", vbQuestion + vbYesNo, "Créer") = vbYes Then
'Si oui on la détruit
Application.DisplayAlerts = False
Sheets(NomFeuille).Delete
Application.DisplayAlerts = True
Else
'Si non on sort
GoTo FinCreation
End If
End If
Sheets("fiche").Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = NomFeuille
'Décommenter la ligne suivante si l'on veut supprimer les boutons de la nouvelle feuille
'SupprimerObjets nomfeuille
'Décommenter la ligne suivant si l'on veut ôter la validation de
'ActiveSheet.Range("H9").Validation.Delete
With Sheets("liste")
Ligne = .Range("A65536").End(xlUp).Row + 1
.Hyperlinks.Add Anchor:=.Cells(Ligne, 1), _
Address:="", _
SubAddress:="'" & NomFeuille & "'!A1", _
TextToDisplay:=NomFeuille
.Cells(Ligne, 2) = Sheets("fiche").Range("E4")
'And
With Sheets("BD")
Ligne = .Range("A65536").End(xlUp).Row + 1
Cells(Ligne, 1) = Sheets("fiche").Range("E2")
Cells(Ligne, 2) = Sheets("fiche").Range("E4")
Cells(Ligne, 3) = Sheets("fiche").Range("E5")
Cells(Ligne, 4) = Sheets("fiche").Range("E7")
Cells(Ligne, 5) = Sheets("fiche").Range("E8") End With
Worksheets("fiche").Select
FinCreation:
End With
End Sub
1 pourquoi la partie en gras ne fonctionne pas?
2 comment faire pour ajouter une instuction en fin de macro pour sélectionner une série de cellulles ?( j'ai essayer plusieurs manières et cela bug à chaque fois)
Si on pouvait me donner la syntaxe pour m'aider à continuer se serait sympa.
Merci
BPOL
tout d'abord mes meilleurs voeux pour l'année nouvelle.
Bon voici mon problème,
j'ai cette macro
Dim NomFeuille As String
Dim Ligne As Integer
'Récupération du nome de la nouvelle feuille
NomFeuille = Range("E2")
'Teste si elle existe déjà.
If FeuilleExiste(NomFeuille) Then
'Si oui, demander s'il faut la remplacer
If MsgBox("La feuille '" & NomFeuille & "' existe déjà!" & vbCrLf & _
"voulez-vous la remplacer?", vbQuestion + vbYesNo, "Créer") = vbYes Then
'Si oui on la détruit
Application.DisplayAlerts = False
Sheets(NomFeuille).Delete
Application.DisplayAlerts = True
Else
'Si non on sort
GoTo FinCreation
End If
End If
Sheets("fiche").Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = NomFeuille
'Décommenter la ligne suivante si l'on veut supprimer les boutons de la nouvelle feuille
'SupprimerObjets nomfeuille
'Décommenter la ligne suivant si l'on veut ôter la validation de
'ActiveSheet.Range("H9").Validation.Delete
With Sheets("liste")
Ligne = .Range("A65536").End(xlUp).Row + 1
.Hyperlinks.Add Anchor:=.Cells(Ligne, 1), _
Address:="", _
SubAddress:="'" & NomFeuille & "'!A1", _
TextToDisplay:=NomFeuille
.Cells(Ligne, 2) = Sheets("fiche").Range("E4")
'And
With Sheets("BD")
Ligne = .Range("A65536").End(xlUp).Row + 1
Cells(Ligne, 1) = Sheets("fiche").Range("E2")
Cells(Ligne, 2) = Sheets("fiche").Range("E4")
Cells(Ligne, 3) = Sheets("fiche").Range("E5")
Cells(Ligne, 4) = Sheets("fiche").Range("E7")
Cells(Ligne, 5) = Sheets("fiche").Range("E8") End With
Worksheets("fiche").Select
FinCreation:
End With
End Sub
1 pourquoi la partie en gras ne fonctionne pas?
2 comment faire pour ajouter une instuction en fin de macro pour sélectionner une série de cellulles ?( j'ai essayer plusieurs manières et cela bug à chaque fois)
Si on pouvait me donner la syntaxe pour m'aider à continuer se serait sympa.
Merci
BPOL