Microsoft 365 Relier deux code VBA

  • Initiateur de la discussion Initiateur de la discussion BERNO
  • 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 !

B

BERNO

Guest
Bonsoir

J'ai un code VBA ( voir ci dessous) qui fonctionne, un deuxième qui seul fonctionne aussi.....a présent j'aimerais les relier pour qu'ils fonctionnent les deux car uniquement le premier fonctionne actuellement

Merci pour l'aide

Berno


Option Explicit
Sub Macro5()
Dim ville$, lig&, col%, ltr$
With ActiveCell
ville = .Value: If ville = "" Then Exit Sub
lig = .Row: If lig < 3 Or lig > 1481 Then Exit Sub
col = .Column: If col <> 5 And col <> 7 And col <> 9 And col <> 11 Then Exit Sub

ltr = Cells(lig, 3): If ltr <> "NUIT" Then Exit Sub
.Offset(4) = ville: If lig <= 1481 Then .Offset(9) = ville
If lig <= 1481 Then .Offset(13) = ville
If lig <= 1481 Then .Offset(18) = ville
If lig <= 1481 Then .Offset(22) = ville

' Deuxième code

ltr = Cells(lig, 3): If ltr <> "MATIN" Then Exit Sub
.Offset(4) = ville: If lig <= 1481 Then .Offset(9) = ville
If lig <= 1481 Then .Offset(13) = ville


End With

End Sub

••••ˇˇˇˇ
 
Bonsoir Berno,
En modifiant vos IF,
If =Nuit
Action si Nuit
Else if = Matin
Action Matin
End If

VB:
Option Explicit
Sub Macro5()
Dim ville$, lig&, col%, ltr$
With ActiveCell
ville = .Value: If ville = "" Then Exit Sub
lig = .Row: If lig < 3 Or lig > 1481 Then Exit Sub
col = .Column: If col <> 5 And col <> 7 And col <> 9 And col <> 11 Then Exit Sub

ltr = Cells(lig, 3)
If ltr = "NUIT" Then
   .Offset(4) = ville: If lig <= 1481 Then .Offset(9) = ville
   If lig <= 1481 Then .Offset(13) = ville
   If lig <= 1481 Then .Offset(18) = ville
   If lig <= 1481 Then .Offset(22) = ville
Else If ltr = "MATIN" Then
   .Offset(4) = ville: If lig <= 1481 Then .Offset(9) = ville
   If lig <= 1481 Then .Offset(13) = ville
END If
End With
End Sub

A tester.
 
- 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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
2
Affichages
488
Réponses
35
Affichages
2 K
Réponses
15
Affichages
569
Réponses
16
Affichages
1 K
Réponses
4
Affichages
540
Retour