Lone-wolf voilà un code plus complet testé avec le dernier fichier base
Private Sub CmdActualiser_Click()
Dim plage As Range, cel As Range, lig%, j%, x%, rw, i
Dim derl%, rart, ncom, debut, fin
If Me.CmbComm <> "" Then
If Me.CheckBox1 Then
With WsRetours
lig = .Range("a65536").End(xlUp).Row + 1
For j = 1 To Me.ListView1.ListItems.Count
.Cells(lig, 1) = lig - 1
.Cells(lig, 2) = CmbComm.Value
.Cells(lig, 3) = TxtClient
.Cells(lig, 4) = Me.ListView1.ListItems(j).SubItems(1)
.Cells(lig, 5) = Me.ListView1.ListItems(j).SubItems(2)
.Cells(lig, 6) = Me.ListView1.ListItems(j).SubItems(3)
.Cells(lig, 7) = Me.ListView1.ListItems(j).SubItems(4)
lig = lig + 1
Next j
'If .Cells(lig, 7) <> "" Then: MsgBox "Les données ont été inscrites.", , "LES MILLES MERVEILLES" ': Exit Sub
.Columns.AutoFit '.Range("A:G")
End With
'factures
WsFact.Range("A" & Me.CmbComm.ListIndex + 2).EntireRow.Delete
Me.CmbComm.List = WsFact.Range("b2:b" & WsFact.Range("b65536").End(xlUp).Row).Value
Me.CmbComm = ""
lig = WsFact.Range("a65536").End(xlUp).Row
For i = 2 To lig
WsFact.Range("A" & i) = i - 1
Next i
'commandes
WsC.Range("A" & Me.CmbComm.ListIndex + 2).EntireRow.Delete
lig = WsC.Range("a65536").End(xlUp).Row
For i = 2 To lig
WsC.Range("A" & i) = i - 1
Next i
With WsDC 'détail cde
derl = .Range("A65536").End(xlUp).Row
For j = Me.ListView1.ListItems.Count To 1 Step -1
For i = derl To 2 Step -1
If .Cells(i, 2) = Me.ListView1.ListItems(j) And .Cells(i, 3) = Me.ListView1.ListItems(j).SubItems(1) Then
.Cells(i, 1).EntireRow.Delete
End If
Next i
Next j
'.Rows.Height = 12.75
Call MontantFacture
End With
With WsStock
For j = Me.ListView1.ListItems.Count To 1 Step -1
rw = Application.Match(Me.ListView1.ListItems(j).SubItems(1), .Columns(3), 0)
.Cells(rw, 9) = .Cells(rw, 9) - Me.ListView1.ListItems(j).SubItems(2)
.Cells(rw, 11) = .Cells(rw, 11) + Me.ListView1.ListItems(j).SubItems(2)
' TxtStockReel = .Cells(rw, 11)
Next j
End With
With WsSav
debut = .Columns(2).Find(Val(Me.CmbComm), LookIn:=xlValues, lookat:=xlWhole).Row
fin = .Range("B" & debut).End(xlDown).Row
For i = fin To debut Step -1
If .Cells(i, 2) = MonItem.ListSubItems(1) Then
cel.EntireRow.Delete
End If
Next i
'.Rows.Height = 12.75
End With
Else
If Not MonItem Is Nothing Then
With WsRetours
lig = .Range("a65536").End(xlUp).Row + 1
.Cells(lig, 1) = lig - 1
.Cells(lig, 2) = CmbComm.Value
.Cells(lig, 3) = TxtClient
.Cells(lig, 4) = MonItem.SubItems(1)
.Cells(lig, 5) = TxtRetours.Value
.Cells(lig, 6) = MonItem.SubItems(3)
.Cells(lig, 7) = MonItem.SubItems(4)
'If .Cells(lig, 7) <> "" Then: MsgBox "Les données ont été inscrites.", , "LES MILLES MERVEILLES" ': Exit Sub
.Columns.AutoFit '.Range("A:G")
End With
'On Error Resume Next
With WsDC 'détail cde
derl = .Range("A65536").End(xlUp).Row
For i = 2 To derl
If .Cells(i, 2) = Val(MonItem) And .Cells(i, 3) = MonItem.ListSubItems(1) Then
.Cells(i, 1).EntireRow.Delete
Exit For
End If
Next i
'.Rows.Height = 12.75
Call MontantFacture
End With
With WsStock
rw = Application.Match(MonItem.SubItems(1), .Columns(3), 0)
.Cells(rw, 9) = .Cells(rw, 9) - TxtRetours
.Cells(rw, 11) = .Cells(rw, 11) + TxtRetours
TxtStockReel = .Cells(rw, 11)
End With
With WsSav
debut = .Columns(2).Find(Val(Me.CmbComm), LookIn:=xlValues, lookat:=xlWhole).Row
fin = .Range("B" & debut).End(xlDown).Row
For i = fin To debut Step -1
If .Cells(i, 2) = MonItem.ListSubItems(1) Then
.Cells(i, 2).EntireRow.Delete
If i - 1 = debut Then
.Cells(debut, 2).EntireRow.Delete 'ligne Me.CmbComm
.Cells(debut + 1, 2).EntireRow.Delete 'ligne vide
Else
Exit For
End If
End If
Next i
'.Rows.Height = 12.75
End With
End If
'ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
End If
End If
End Sub