1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
| Sub RegroupBalance()
Application.ScreenUpdating = False
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim Lig As Long
Set F1 = Sheets("Feuil1")
Set F2 = Sheets("Feuil2")
Dim NunCompte As Integer
NunCompte = InputBox("Entrez les deux premiers chiffres du compte comptable : ", "Saisie numérique")
F2.Cells.ClearContents
Lig = 2
Dim i As Long
Dim Balance
Balance = F1.Range("A2:E" & F1.Range("A" & Rows.Count).End(xlUp).Row)
For i = 1 To UBound(Balance)
If Left(Balance(i, 1), 2) = NunCompte And Balance(i, 3) < 0 And Balance(i, 5) < 0 Then
F2.Cells(Lig, "A") = Balance(i, 1)
F2.Cells(Lig, "B") = Balance(i, 2)
F2.Cells(Lig, "C") = Balance(i, 3)
F2.Cells(Lig, "D") = Balance(i, 5)
End If
If Left(Balance(i, 1), 2) = NunCompte And Balance(i, 3) < 0 And Balance(i, 5) > 0 Then
F2.Cells(Lig, "A") = Balance(i, 1)
F2.Cells(Lig, "B") = Balance(i, 2)
F2.Cells(Lig, "C") = Balance(i, 3)
End If
If Left(Balance(i, 1), 2) = NunCompte And Balance(i, 3) > 0 And Balance(i, 5) < 0 Then
F2.Cells(Lig, "A") = Balance(i, 1)
F2.Cells(Lig, "B") = Balance(i, 2)
F2.Cells(Lig, "C") = Balance(i, 5)
End If
If F2.Cells(Lig, "A") <> "" Then Lig = Lig + 1
Next i
Application.ScreenUpdating = True
Set F1 = Nothing
Set F2 = Nothing
End Sub |
Partager