Discussion :

[Faicel.93]

Bonjour,
Je m'adresse à vous si vous pouvez me régler ce petit problème. Cherchant à faire un copier vers vers le bas sous excel, j'ai trouvé une macro sur internet qui permet de remplir les cellules vides de chaque colonne avec les valeurs de la cellule remplie qui précède, mais le problème c'est que pour certaines colonnes dont la première ligne est vide il fait un copier de l'entête de la colonne. Alors j'aimerais bien savoir s'il y'a quelqu'un qui pourrait m'aider sur ce problème et je lui serais reconnaissant. Merci d'avance.

Voilà le code VBA, si jamais y'a quelqu'un qui peut rajouter une petite modification pour éviter ce problème.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub FillColBlanksSpecial()
 
Dim wks As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim LastRow As Long
Dim col As Long
Dim lRows As Long
Dim lLimit As Long
 
Dim lCount As Long
On Error Resume Next
 
lRows = 2 'starting row
lLimit = 8000
 
Set wks = ActiveSheet
With wks
   col = ActiveCell.Column
 
   Set rng = .UsedRange  'try to reset the lastcell
   LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
   Set rng = Nothing
 
    lCount = .Columns(col).SpecialCells(xlCellTypeBlanks).Areas(1).Cells.Count
 
    If lCount = 0 Then
        MsgBox "No blanks found in selected column"
        Exit Sub
    ElseIf lCount = .Columns(col).Cells.Count Then
        MsgBox "Over the Special Cells Limit" 'this line can be deleted
        Do While lRows < LastRow
            Set rng = .Range(.Cells(lRows, col), .Cells(lRows + lLimit, col)) _
                           .Cells.SpecialCells(xlCellTypeBlanks)
            rng.FormulaR1C1 = "=R[-1]C"
            lRows = lRows + lLimit
        Loop
    Else
        Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _
                       .Cells.SpecialCells(xlCellTypeBlanks)
        rng.FormulaR1C1 = "=R[-1]C"
    End If
 
   'replace formulas with values
   With .Cells(1, col).EntireColumn
       .Value = .Value
   End With
 
End With
 
End Sub