Faire fonctionner une macro sur certaines colonnes
Bonjour,
Voici mon problème : Actuellement la macro ci-dessous (pompé sur un site) fonctionne pour les colonnes AA, AB et AC (cf ligne target.column > 25 etc...).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
Dim semiColonCnt As Integer
Dim xType As Integer
If Target.Count > 1 Then Exit Sub
On Error Resume Next
' *** Problème ICI ***
If Not (Target.Column > 25 And Target.Column < 30) Then Exit Sub
xType = 0
xType = Target.Validation.Type
If xType = 3 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Then
If xValue2 <> "" Then
If xValue1 = xValue2 Or xValue1 = xValue2 & ";" Or xValue1 = xValue2 & "; " Then
xValue1 = Replace(xValue1, vbLf, "")
xValue1 = Replace(xValue1, vbLf, "")
Target.Value = xValue1
ElseIf InStr(1, xValue1, vbLf & xValue2) Then
xValue1 = Replace(xValue1, vbLf & xValue2, "")
Target.Value = xValue1
ElseIf InStr(1, xValue1, xValue2 & vbLf) Then
xValue1 = Replace(xValue1, xValue2, "")
Target.Value = xValue1
Else
Target.Value = xValue1 & vbLf & xValue2
End If
Target.Value = Replace(Target.Value, ";;", vbLf)
Target.Value = Replace(Target.Value, "; ;", vbLf)
If Target.Value <> "" Then
If Right(Target.Value, 2) = "; " Then
Target.Value = Left(Target.Value, Len(Target.Value) - 2)
End If
End If
If InStr(1, Target.Value, vbLf) = 1 Then
Target.Value = Replace(Target.Value, vbLf, "", 1, 1)
End If
If InStr(1, Target.Value, vbLf) = 1 Then
Target.Value = Replace(Target.Value, vbLf, "", 1, 1)
End If
semiColonCnt = 0
For i = 1 To Len(Target.Value)
If InStr(i, Target.Value, vbLf) Then
semiColonCnt = semiColonCnt + 1
End If
Next i
If semiColonCnt = 1 Then
Target.Value = Replace(Target.Value, vbLf, "")
Target.Value = Replace(Target.Value, vbLf, "")
End If
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
J'aimerai que la macro fonctionne aussi sur les colonnes AU, AV, AW et BO, BP, BQ et CJ, CK, CL et DD, DE, DF.
Auriez-vous une solution à mon problème svp ?
Je précise que je suis très novice sur les macros.
Merci.
Bonjour SaidZ et
Une petite présentation ICI serait la bienvenue
Si vous ne l'avez pas encore fait, je vous invite à lire :
- La charte du forum
- Quelques fonctionnalités du forum à connaître
qui vous aideront dans vos demandes et réponses sur ce forum.
Regardez aussi les petites icônes mises à votre disposition dans la barre de menu qui :
- vous permettent de poster un code (</>)
- ou de clôturer un fil lorsque vous avez terminé (V)
Concernant votre demande, voici les lignes à mettre
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRng As Range
Dim xValue1 As String, xValue2 As String
Dim semiColonCnt As Integer, xType As Integer
If Target.Count > 1 Then Exit Sub
On Error Resume Next
Dim RngCol As Range
Set RngCol = Range("AA:AE,AU:AW,BO:BQ,CJ:CL,DD:DF")
' Si la cellule modifiée n'est pas contenue dans la plage, on sort
If Intersect(RngCol, Target) Is Nothing Then Exit Sub
' Le reste du code...
Merci pour votre participation
Cordialement
Bonjour Bruno,
Merci pour ta réponse ! La présentation a été faite et la macro fonctionne merci !