azraf

New Member
Joined
Oct 11, 2018
Messages
1
Hi guys,

This is the macro that i create to insert a new number. Note that I have more than one sheets in my workboooks. In each sheets, there is a column called line reference. The line reference is defined as for exemple A050 or A001. It goes from A to F. For exemple we have A01 sheets, A02 sheets, B01 sheets and it goes untill F sheets.

So the problem is that when I want to a new in one of these sheets, for exemple in sheets B, the line reference should be the highest value from all these sheets. For exemple, in sheets B (B01, B02 ..), if the highest value is B060, and i want to add a new line in B01, the line reference should be B061.

But the problem is, when i add the line and run this macro, its takes the last line of the last sheets of B for exemple as the highest number. It is not correct because sometimes the highest number is not always at the last sheets B for example. So guys pls helps me


Code:
Sub AA_Numeration_Nvx_Essais()
'Appliquer un nouveau numéro d'essai aux essais sans numéro.
Dim derligne, n, a, MaxV, MaxA, MaxB, MaxC, MaxD, MaxE, MaxF As Integer


For a = 2 To Sheets("F05 Equipement optionnel élec").Index
Sheets(a).Activate


derligne = Sheets(a).Range("G65536").End(xlUp).Row


'Recherche des valeurs max pour chaque groupe organe
If Left(Range("B" & 3).Value, 1) = "0" Then
    MaxV = Right(Range("B3").Value, 3)
    For n = 4 To derligne
    If Right(Range("B" & n).Value, 3) > MaxV Then
    MaxV = Right(Range("B" & n).Value, 3)
    End If
Next
End If


If Left(Range("B" & 3).Value, 1) = "A" Then
    MaxA = Right(Range("B3").Value, 3)
    For n = 4 To derligne
    If Right(Range("B" & n).Value, 3) > MaxA Then
    MaxA = Right(Range("B" & n).Value, 3)
    End If
Next
End If


If Left(Range("B" & 3).Value, 1) = "B" Then
    MaxB = Right(Range("B3").Value, 3)
    For n = 4 To derligne
    If Right(Range("B" & n).Value, 3) > MaxB Then
    MaxB = Right(Range("B" & n).Value, 3)
    End If
Next
End If


If Left(Range("B" & 3).Value, 1) = "C" Then
    MaxC = Right(Range("B3").Value, 3)
    For n = 4 To derligne
    If Right(Range("B" & n).Value, 3) > MaxC Then
    MaxC = Right(Range("B" & n).Value, 3)
    End If
Next
End If


If Left(Range("B" & 3).Value, 1) = "D" Then
    MaxD = Right(Range("B3").Value, 3)
    For n = 4 To derligne
    If Right(Range("B" & n).Value, 3) > MaxD Then
    MaxD = Right(Range("B" & n).Value, 3)
    End If
Next
End If


If Left(Range("B" & 3).Value, 1) = "E" Then
    MaxE = Right(Range("B3").Value, 3)
    For n = 4 To derligne
    If Right(Range("B" & n).Value, 3) > MaxE Then
    MaxE = Right(Range("B" & n).Value, 3)
    End If
Next
End If


If Left(Range("B" & 3).Value, 1) = "F" Then
    MaxF = Right(Range("B3").Value, 3)
    For n = 4 To derligne
    If Range("B" & n).Value > MaxF Then
    MaxF = Right(Range("B" & n).Value, 3)
    End If
Next
End If


Next


For a = 2 To Sheets("F05 Equipement optionnel élec").Index
Sheets(a).Activate


derligne = Sheets(a).Range("G65536").End(xlUp).Row


'Recherche valeur vide + Attribution code


For n = 3 To derligne
If Range("B" & n).Value = "" Then


'Information sur la page et ligne vide
MsgBox ActiveSheet.Name & Chr(10) & "Ligne : " & n


If Left(Range("J" & n).Value, 1) = "0" Then
    MaxV = MaxV + 1
    If MaxV < 100 Then
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & "0" & MaxV
    Else
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & MaxV
    End If
    Range("B" & n).Select
    'Mise en évidence des cases modifiées
    Call Couleur
    End If
    
If Left(Range("J" & n).Value, 1) = "A" Then
    MaxA = MaxA + 1
    If MaxA < 100 Then
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & "0" & MaxA
    Else
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & MaxA
    End If
    Range("B" & n).Select
    Call Couleur
    End If
    
If Left(Range("J" & n).Value, 1) = "B" Then
    MaxB = MaxB + 1
    If MaxB < 100 Then
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & "0" & MaxB
    Else
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & MaxB
    End If
    Range("B" & n).Select
    Call Couleur
    End If
    
If Left(Range("J" & n).Value, 1) = "C" Then
    MaxC = MaxC + 1
    If MaxC < 100 Then
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & "0" & MaxC
    Else
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & MaxC
    End If
    Range("B" & n).Select
    Call Couleur
    End If
    
If Left(Range("J" & n).Value, 1) = "D" Then
    MaxD = MaxD + 1
    If MaxD < 100 Then
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & "0" & MaxD
    Else
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & MaxD
    End If
    Range("B" & n).Select
    Call Couleur
    End If
    
If Left(Range("J" & n).Value, 1) = "E" Then
    MaxE = MaxE + 1
    If MaxE < 100 Then
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & "0" & MaxE
    Else
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & MaxE
    End If
    Range("B" & n).Select
    Call Couleur
    End If


If Left(Range("J" & n).Value, 1) = "F" Then
    MaxF = MaxF + 1
    If MaxF < 100 Then
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & "0" & MaxF
    Else
    Range("B" & n).Value = Left(Range("J" & n).Value, 1) & MaxF
    End If
    Range("B" & n).Select
    Call Couleur
    End If
       
End If
Next
Next


End Sub
 
Last edited by a moderator:

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top