'********************************************************************
' Remplace les cellules vides par la valeur de la première
' cellule non vide immédiatement au-dessus ou au-dessous.
' Cette procédure parcours la sélection de HAUT en BAS et inversement
' ATTENTION : Cette procédure utilise la sélection en cours
'********************************************************************
Sub FillEmptyLinesWithValue()
Dim i As Long
Dim j As Long
Dim nbColonnes As Long
Dim Start As Long
Dim Finish As Long
Dim TopBot As Byte
Dim Direction As Integer
Dim MyArray, Valeur As Variant
Dim MyRange As Range
Dim Msg As String
On Error GoTo GestionErreur
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set MyRange = Selection
With MyRange
nbColonnes = .Columns.Count
MyArray = .Value
End With
Msg = 'Pour effectuer un remplacement de ' & vbCr
Msg = Msg & 'HAUT en BAS cliquer sur le bouton OUI' & vbCr
Msg = Msg & 'BAS en HAUT cliquer sur le bouton NON'
TopBot = MsgBox(Msg, vbYesNoCancel + vbQuestion, TITLE)
Select Case TopBot
Case vbCancel
End
Case vbYes
Start = 1: Finish = UBound(MyArray, 1): Direction = 1
Case Else
Start = UBound(MyArray, 1): Finish = 1: Direction = -1
End Select
For i = 1 To nbColonnes
Valeur = ''
For j = Start To Finish Step Direction
Select Case VarType(MyArray(j, i))
Case vbEmpty
MyArray(j, i) = Valeur
Case Else
Valeur = MyArray(j, i)
End Select
Next
Next
MyRange.Value = MyArray
GestionErreur:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub