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 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
| Sub test()
Dim C As Range, X As Range, Feuille As String, Derligne As Integer
With Sheets("Balance N")
For Each C In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
Feuille = ""
Derligne = .Cells(.Rows.Count, 8).End(xlUp).Row
For Each X In .Range("H18:H" & Derligne)
If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
Feuille = "Immos financieres"
Exit For
End If
Next X
If Feuille = "" Then
Derligne = .Cells(.Rows.Count, 10).End(xlUp).Row
For Each X In .Range("J18:J" & Derligne)
If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
Feuille = "Provisions"
Exit For
End If
Next X
End If
If Feuille = "" Then
Derligne = .Cells(.Rows.Count, 12).End(xlUp).Row
For Each X In .Range("L18:L" & Derligne)
If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
Feuille = "Op. Exceptionnelles"
Exit For
End If
Next X
End If
If Feuille <> "" Then
With Sheets(Feuille)
Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, 1).Resize(, 3).Value = C.Resize(, 3).Value
.[A:D].EntireColumn.AutoFit
End With
End If
Next C
End With
Feuille = ""
With Sheets("Balance N-1")
For Each C In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
' If C.Row = 27 Then Stop
Feuille = ""
Derligne = .Cells(.Rows.Count, 8).End(xlUp).Row
For Each X In .Range("H18:H" & Derligne)
If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
Feuille = "Immos financieres"
Exit For
End If
Next X
If Feuille = "" Then
Derligne = .Cells(.Rows.Count, 10).End(xlUp).Row
For Each X In .Range("J18:J" & Derligne)
If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
Feuille = "Provisions"
Exit For
End If
Next X
End If
If Feuille = "" Then
Derligne = .Cells(.Rows.Count, 12).End(xlUp).Row
For Each X In .Range("L18:L" & Derligne)
If C.Value >= X.Value And C.Value <= X.Offset(, 1).Value Then
Feuille = "Op. Exceptionnelles"
Exit For
End If
Next X
End If
If Feuille <> "" Then
With Sheets(Feuille)
Ligne = .Cells(.Rows.Count, 6).End(xlUp).Row + 1
.Cells(Ligne, 6).Resize(, 3).Value = C.Resize(, 3).Value
.[F:H].EntireColumn.AutoFit
End With
End If
Next C
End With
End Sub |
Partager