modifier une ligne If Not Intersect(Target, Columns(3)) Is Nothing And Not IsEmpty(

Créer une discussion
Répondre

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 !

S'inscrire
Trier par date Trier par votes
Re : modifier une ligne If Not Intersect(Target, Columns(3)) Is Nothing And Not IsE

Code: 
  Private Sub Worksheet_Change(ByVal Target As Range)

   If Not Intersect(Target, Columns(3)) Is Nothing And Not IsEmpty(Target.Cells(1, 1).Value) Then
      Application.ScreenUpdating = False
    ThisWorkbook.Sheets("modèle feuille").Visible = True
      ThisWorkbook.Sheets("modèle feuille").Copy After:=Me
      On Error GoTo nom_incorrect
      ActiveSheet.Name = CStr(Target.Cells(1, 1).Value)
      On Error GoTo 0
      Me.Hyperlinks.Add Anchor:=Target, Address:="", SubAddress:=Target & "!A1"
      Me.Activate
      Application.ScreenUpdating = True
    ThisWorkbook.Sheets("modèle feuille").Visible = False
   End If
Exit Sub
nom_incorrect:
   Application.DisplayAlerts = False
   ActiveSheet.Delete
   Application.DisplayAlerts = True
   Me.Activate
   MsgBox "Il existe déjà une feuille nommée " & """" & CStr(Target.Cells(1, 1).Value) & """" & _
      vbLf & "ou ce nom est incorrect."
End

End Sub
bonsoir à tous
grâce à ce code de roger 2327 que je remercie à nouveau, je peux créer une nouvelle feuille qui est la copie de "modèle feuille"
je cherche le moyen de pouvoir copier un autre modèle de feuille "nommée par exemple "modèle feuille 2"
je pensais à me servir de la colonne A qui si elle contient "camion" par exemple créerait la feuille modèle 2
j'envisage par la suite d'avoir 4 ou 5 modèles de feuilles à copier en fonction du contenu de la colonne A par exemple voiture pour "modèle feuille 3"
ou remorque pour le modèle feuille 4
il y a aussi une autre solution avec la colonne C mais sur une zone réduite par exemple c4:c30
mais je ne sais pas transformer cette ligne
Code: 
  If Not Intersect(Target, Columns(3)) Is Nothing And Not IsEmpty(Target.Cells(1, 1).Value) Then
merci pour votre aide[/QUOTE]
 
Vote positif 0 Vote négatif
Re : modifier une ligne If Not Intersect(Target, Columns(3)) Is Nothing And Not IsE

Code: 
If Not Intersect(Target, Range("c5:c35")) Is Nothing And Not IsEmpty(Target.Cells(1, 1).Value) Then
      Application.ScreenUpdating = False
    ThisWorkbook.Sheets("Feuille modèle raboteuse").Visible = True
      ThisWorkbook.Sheets("Feuille modèle raboteuse").Copy After:=Me
      On Error GoTo nom_incorrect
      ActiveSheet.Name = CStr(Target.Cells(1, 1).Value)
      On Error GoTo 0
      Me.Hyperlinks.Add Anchor:=Target, Address:="", SubAddress:=Target & "!A1"
      Me.Activate
      Application.ScreenUpdating = True
    ThisWorkbook.Sheets("Feuille modèle raboteuse").Visible = False
   End If
Exit Sub
nom_incorrect:
   Application.DisplayAlerts = False
   ActiveSheet.Delete
   Application.DisplayAlerts = True
   Me.Activate
   MsgBox "Il existe déjà une feuille nommée " & """" & CStr(Target.Cells(1, 1).Value) & """" & _
      vbLf & "ou ce nom est incorrect."
End

'copier feuille modèle
If Not Intersect(Target, Range("c37:c81")) Is Nothing And Not IsEmpty(Target.Cells(1, 1).Value) Then
    Application.ScreenUpdating = False
   ThisWorkbook.Sheets("modèle feuille").Visible = True
     ThisWorkbook.Sheets("modèle feuille").Copy After:=Me
    On Error GoTo nom_incorrect1
      ActiveSheet.Name = CStr(Target.Cells(1, 1).Value)
      On Error GoTo 0
      Me.Hyperlinks.Add Anchor:=Target, Address:="", SubAddress:=Target & "!A1"
      Me.Activate
      Application.ScreenUpdating = True
    ThisWorkbook.Sheets("modèle feuille").Visible = False
   End If
Exit Sub
nom_incorrect1:
  Application.DisplayAlerts = False
  ActiveSheet.Delete
 Application.DisplayAlerts = True
   Me.Activate
   MsgBox "Il existe déjà une feuille nommée " & """" & CStr(Target.Cells(1, 1).Value) & """" & _
      vbLf & "ou ce nom est incorrect."
End



End Sub
bonsoir le forum
j'ai fais un essai en copiant la macro et en l'adaptant pour une nouvelle zone de la colonne C
mais dans le cas du deuxième code ça ne copie pas la feuille
pouvez vous me dire ce qui cloche
merci
le but étant de dupliquer ce code 4 ou 5 fois c'est à dire 4 ou 5 feuilles modèle et 4 ou 5 zones de la colonne C
 
Vote positif 0 Vote négatif
Re : modifier une ligne If Not Intersect(Target, Columns(3)) Is Nothing And Not IsE

j'ai inversé les zones dans les codes et visiblement c'est la zone c37:c81 qui pose problème ?????
autrement en ne gardant que la 1ere partie du code n'est'il pas possible d'avoir un message me demandant quelle feuille je veux recopier (4 ou 5 possibiltés)
 
Vote positif 0 Vote négatif
Re : modifier une ligne If Not Intersect(Target, Columns(3)) Is Nothing And Not IsE

Re...
Voici deux essais.
Code: 
[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim oRef As String, nRef As Long, rRef As Long
[COLOR="SeaGreen"]'=== Paramètres :[/COLOR]
   oRef = "C2"          [COLOR="SeaGreen"]'Adresse de la première cellule de la liste des modèles.[/COLOR]
   nRef = 9             [COLOR="SeaGreen"]'Nombre maximum de modèle(s).
'================[/COLOR]
   rRef = Range(oRef).Row
   If Not Intersect(Target, Range(oRef).Resize(Rows.Count - rRef, nRef).Offset(1, 0)) Is Nothing And Not IsEmpty(Target.Cells(1, 1).Value) Then
      Application.ScreenUpdating = False
      On Error GoTo modèle_inexistant
      ThisWorkbook.Sheets(Cells(rRef, Target.Cells(1, 1).Column).Value).Copy After:=Me
      On Error GoTo nom_incorrect
      ActiveSheet.Name = CStr(Target.Cells(1, 1).Value)
      On Error GoTo 0
      Me.Hyperlinks.Add Anchor:=Target, Address:="", SubAddress:=ActiveSheet.Name & "!A1"
      Me.Activate
      Application.ScreenUpdating = True
   End If
Exit Sub
modèle_inexistant:
   MsgBox "Il n'existe pas de feuille-modèle nommée " & """" & CStr(Cells(rRef, Target.Cells(1, 1).Column).Value) & """"
End
nom_incorrect:
   Application.DisplayAlerts = False
   ActiveSheet.Delete
   Application.DisplayAlerts = True
   Me.Activate
   Target.Cells(1, 1).Select
   Application.ScreenUpdating = True
   MsgBox "Il existe déjà une feuille nommée " & """" & CStr(Target.Cells(1, 1).Value) & """" & _
      vbLf & "ou ce nom est incorrect."
End
End Sub[/B][/COLOR]
Les noms des modèles sont dans la plage C2:K2. En inscrivant dans les lignes en dessous des noms de feuilles, ces feuilles seront créées sur le modèle de la feuille nommée en tête de colonne.
Les deux lignes de paramètres au début du code permettent de choisir une autre zone pour les données.

Voici la version transposée :
Code: 
[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim oRef As String, nRef As Long, rRef As Long
[COLOR="SeaGreen"]'=== Paramètres :[/COLOR]
   oRef = "B3"          [COLOR="SeaGreen"]'Adresse de la première cellule de la liste des modèles.[/COLOR]
   nRef = 9             [COLOR="SeaGreen"]'Nombre maximum de modèle(s).
'================[/COLOR]
   rRef = Range(oRef).Column
   If Not Intersect(Target, Range(oRef).Resize(nRef, Columns.Count - rRef).Offset(0, 1)) Is Nothing And Not IsEmpty(Target.Cells(1, 1).Value) Then
      Application.ScreenUpdating = False
      On Error GoTo modèle_inexistant
      ThisWorkbook.Sheets(Cells(Target.Cells(1, 1).Row, rRef).Value).Copy After:=Me
      On Error GoTo nom_incorrect
      ActiveSheet.Name = CStr(Target.Cells(1, 1).Value)
      On Error GoTo 0
      Me.Hyperlinks.Add Anchor:=Target, Address:="", SubAddress:=ActiveSheet.Name & "!A1"
      Me.Activate
      Application.ScreenUpdating = True
   End If
Exit Sub
modèle_inexistant:
   MsgBox "Il n'existe pas de feuille-modèle nommée " & """" & CStr(Cells(Target.Cells(1, 1).Row, rRef).Value) & """"
End
nom_incorrect:
   Application.DisplayAlerts = False
   ActiveSheet.Delete
   Application.DisplayAlerts = True
   Me.Activate
   Target.Cells(1, 1).Select
   Application.ScreenUpdating = True
   MsgBox "Il existe déjà une feuille nommée " & """" & CStr(Target.Cells(1, 1).Value) & """" & _
      vbLf & "ou ce nom est incorrect."
End
End Sub[/B][/COLOR]
Les noms des modèles sont dans la plage B3:B11. En inscrivant dans les colonnes à droite des noms de feuilles, ces feuilles seront créées sur le modèle de la feuille nommée en tête de ligne.

Voyez le classeur joint.
Je ne suis pas certain d'avoir tout compris de votre problème. Pour, éventuellement, aller plus loin, un classeur-modèle sera le bienvenu.​
ROGER2327
#2223
 

Pièces jointes

Vote positif 0 Vote négatif
Re : modifier une ligne If Not Intersect(Target, Columns(3)) Is Nothing And Not IsE

bonsoir roger et merci pour ton aide
la solution que tu as apportée m'a obligé à modifier un peu la mise page mais l'important est quelle fonctionne parfaitement
merci encore et bonne soirée
 
Vote positif 0 Vote négatif
Re : modifier une ligne If Not Intersect(Target, Columns(3)) Is Nothing And Not IsE

Re...
pascal21 à dit:
bonsoir roger et merci pour ton aide
la solution que tu as apportée m'a obligé à modifier un peu la mise page mais l'important est quelle fonctionne parfaitement
merci encore et bonne soirée
Cliquez pour agrandir...
Parfait, mais comme je disais plus haut, en voyant l'environnement souhaité, c'est-à-dire un classeur, même simplifié, avec quelques indications précises sur le fonctionnement, il est certainement possible d'apporter des modifications. A vous de voir...​
ROGER2327
#2228
 
Vote positif 0 Vote négatif
Re : modifier une ligne If Not Intersect(Target, Columns(3)) Is Nothing And Not IsE

voilà que ça ne fonctionne plus
ça ne produit plus les copies de feuilles
je simplifierai le classeur pour pouvoir le poster pour l'instant il est trop lourd (env 150 ko zippé)
je m'occupe de ça demain
 
Vote positif 0 Vote négatif
Re : modifier une ligne If Not Intersect(Target, Columns(3)) Is Nothing And Not IsE

Re...
pascal21 à dit:
voilà que ça ne fonctionne plus
ça ne produit plus les copies de feuilles
je simplifierai le classeur pour pouvoir le poster pour l'instant il est trop lourd (env 150 ko zippé)
je m'occupe de ça demain
Cliquez pour agrandir...
Damned !
Il va falloir tirer cela au clair. On devrait y arriver avec le classeur que vous préparez. Bon courage.​
ROGER2327
#2234
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
617
un internaute
U
U
  • Question Question
Autres [RÉSOLU] Compléter macro pour Suppr cellules
Réponses
7
Affichages
457
un internaute
U
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
745
un internaute
U
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
482
nabilexcel2007
N
anthoYS
  • Résolu(e)
XL 2019 Modifier ce code pour de sorte à y rajouter un commentaire après clic droit en colonne I (9) à préremplir mais vierge ?
Réponses
8
Affichages
278
anthoYS
anthoYS
anthoYS
  • Résolu(e)
XL 2019 Comment modifier ces codes VB de sorte que le clic droit sur un commentaire présent, permette l'édition et non cette erreur (capture) ?
Réponses
6
Affichages
254
anthoYS
anthoYS
anthoYS
  • Résolu(e)
XL 2019 Adapter ce code, et améliorer le tableau avec graphique à l'année à y insérer ?
Réponses
4
Affichages
488
sylvanu
sylvanu
F
  • Résolu(e)
Microsoft 365 Evènement worksheet_change
Réponses
2
Affichages
304
Francky79
F
S
  • Résolu(e)
Microsoft 365 Déclenchement macro en série suite à cellule fusionnées
Réponses
3
Affichages
534
spike29
S
P
  • Résolu(e)
XL 2021 Comment détecter la modification MANUELLE d'une cellule dans une feuille ?
Réponses
3
Affichages
337
PRy
P
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
430
patricktoulon
patricktoulon
W
  • Résolu(e)
XL 2016 Placer mes photos dans la colonne A, [A3], [A4],etc, jusqu'en [A99] selon le prénom et le nom colonnes B et C
2
Réponses
29
Affichages
2 K
TooFatBoy
TooFatBoy
richardlion
  • Question Question
XL 2016 annulation ou désactivation de macro
2
Réponses
27
Affichages
1 K
job75
job75
anthoYS
  • Résolu(e)
Microsoft 365 VBA : Commentaire en B, C, D après clic droit dans n'importe quelle cellule de cette plage ?
2
Réponses
15
Affichages
836
Nicolas JACQUIN
Nicolas JACQUIN
S
  • Résolu(e)
Microsoft 365 Cliquer pour ouvrir des photos
Réponses
7
Affichages
961
Simon 1234
S
A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
3 K
Dranreb
Dranreb
J
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
590
jalaba
J
A
  • Question Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
795
sylvanu
sylvanu
M
  • Question Question
Autres Problème de sélection
Réponses
14
Affichages
484
fanch55
fanch55
S
  • Résolu(e)
XL 2019 VBA automatiser hauteur de lignes
Réponses
7
Affichages
562
sofmat
S
Retour