Excel partagé ne trie mal

Bonjour, a tous

je suis en bts et je doit réalisé un fichier excel capable de réalisé un inventaire permanent des chutes alu. Ce fichier doit étre modifiable par plusieurs postes en même temps.

Mon problème c'est le partage qui me fait tout beugué, car quand je demande de rangé un certain nombre de cellule selectionner, il me range bien la selection mais range aussi les collones a coté de la selection
le code le voila :
Private Sub Comtriechute_Click()
Range("B9:G7500").Select 'rangement par désignation couleur longueur
Selection.Sort Key1:=Range("B10"), Order1:=xlAscending, Key2:=Range("C10" _
), Order2:=xlAscending, Key3:=Range("D10"), Order3:=xlAscending, Header _
:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E9").Select
End Sub

j'ai aussi un autre probleme car quand je veux suprimé une ligne via une boite de dialogue (donc une chute a enlever du fichier) cela ne marche pas. Mais pour rentré une chute tout marche bien voila le code pour une sortie de chute

Private Sub CommandButton3_Click()
Sheets("stock sortant").Range("B10").Value = TextBox1.Value
Unload Me
End Sub

Private Sub CommandButton4_Click()
Unload Me
End Sub
Private Sub CommandButton6_Click()
Unload Me
End Sub

Private Sub ComboBox5_Change()

End Sub

Private Sub ComAnnulCB_Click()
Unload Me
Sheets("stock réel").Select
Application.ScreenUpdating = True
End Sub

Private Sub ComAnnulManuel_Click()
Unload Me
Sheets("stock réel").Select
Application.ScreenUpdating = True
End Sub
Private Sub ComOkCB_Click()
Dim Ch As Variant
Ch = Split(TexCB, ";")
On Error Resume Next
If TexCB = "" Then Exit Sub

Dim num As Integer
'nombre de ;
num = NbOc(TexCB, ";")
If num <> 2 Then
MsgBox "Formatage du code pas valable"
Exit Sub
End If

Dim Recherche As String
Recherche = Ch(0) & ";" & Ch(1) & ";" & Ch(2)

Sheets("stock réel").Select
x = Sheets("stock réel").Columns(5).Cells.Find(What:=Recherche).Select
If x = True Then
ActiveCell.Offset(0, -3).Range("A1:F1").Select
Selection.Delete Shift:=xlUp

Application.ScreenUpdating = False
Sheets("stock sortant").Select
Range("b8").Select
Do Until IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.FormulaR1C1 = Ch(0)
ActiveCell.Offset(0, 1).FormulaR1C1 = Ch(1)
ActiveCell.Offset(0, 2).FormulaR1C1 = Ch(2)
ActiveCell.Offset(0, 3).FormulaR1C1 = Date

Sheets("stock réel").Select
Else
MsgBox "Chute pas trouvée!"
End If

Application.ScreenUpdating = True
Unload Me
End Sub

Private Sub ComOkManuel_Click()
On Error Resume Next
Dim Recherche As String
Recherche = ComNomProfil & ";" & ComCouleur & ";" & TexLong

Sheets("stock réel").Select
x = Sheets("stock réel").Columns(5).Cells.Find(What:=Recherche).Select
If x = True Then
ActiveCell.Offset(0, -3).Range("A1:F1").Select
Selection.Delete Shift:=xlUp

Application.ScreenUpdating = False
Sheets("stock sortant").Select
Range("b8").Select
Do Until IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.FormulaR1C1 = ComNomProfil
ActiveCell.Offset(0, 1).FormulaR1C1 = ComCouleur
ActiveCell.Offset(0, 2).FormulaR1C1 = TexLong
ActiveCell.Offset(0, 3).FormulaR1C1 = Date

Sheets("stock réel").Select
Else
MsgBox "Chute pas trouvée!"
End If


Application.ScreenUpdating = True
Unload Me
End Sub

Private Sub MultiPage1_Change()
If MultiPage1.Value = 0 Then
TexCB.SetFocus
End If
End Sub

Private Sub UserForm_Activate()
If MultiPage1.Value = 0 Then
TexCB.SetFocus
End If
End Sub

C'est tout le code de la boite de dialogue par contre désoler si cela fait long