Problème Copier vers le bas sous excel (Débutant en VBA)

Version imprimable

1 pièce(s) jointe(s)

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:

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

Pièce jointe 302947

Citation:

Envoyé par Faicel.93

A tester :

Code:

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
 
Sub RemplirLesCellulesVides(ByVal FeuilleEnCours As Worksheet, ByVal LigneDeTitre As Long, ByVal LigneLimite As Long, ByVal ColonneEnCours As Long)
 
Dim DerniereLigne As Long, LigneEnCours As Long
Dim ValeurEnCours As Variant
 
        With FeuilleEnCours
             DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
             If DerniereLigne < LigneLimite Then LigneLimite = DerniereLigne
 
             If .Cells(LigneDeTitre + 1, ColonneEnCours) = "" Then
                ValeurEnCours = "Sans info"
                .Cells(LigneDeTitre + 1, ColonneEnCours) = ValeurEnCours
             Else
                ValeurEnCours = .Cells(LigneDeTitre + 1, ColonneEnCours)
             End If
 
             For LigneEnCours = LigneDeTitre + 1 To LigneLimite
                 If LigneEnCours < LigneLimite Then
                    Select Case .Cells(LigneEnCours + 1, ColonneEnCours)
                           Case ValeurEnCours
 
                           Case ""
                                .Cells(LigneEnCours + 1, ColonneEnCours) = ValeurEnCours
                           Case Else
                                ValeurEnCours = .Cells(LigneEnCours + 1, ColonneEnCours)
                    End Select
                 End If
             Next LigneEnCours
        End With
 
End Sub
 
 
Sub TestRemplirLesCellulesVides()
 
Dim MaLigneDeTitre As Long, MaLigneLimite As Long, MaColonneEnCours As Long
 
    MaLigneDeTitre = 1
    MaLigneLimite = 8000
    MaColonneEnCours = 1
 
    RemplirLesCellulesVides ActiveSheet, MaLigneDeTitre, MaLigneLimite, MaColonneEnCours
 
End Sub

16/08/2017, 09h54
Faicel.93

Merci Eric, ça a marché mais juste pour la première colonne, dès que j'essaye d'appliquer la macro pour les autres colonnes elle ne mache pas, vous n'avez pas une idée sur celà ? Merci par avance.
16/08/2017, 10h04
Invité

Citation:

Envoyé par Faicel.93

Ben non ! en changeant les paramètres TestRemplirLesCellulesVides, ça va fonctionner.
16/08/2017, 10h39
Faicel.93

Merci beaucoup Erik ça a marché sauf pour les colonnes qui commencent avec un 0 il ne recopie pas les 0 mais les autres valeurs, aussi j'aimerais savoir s'il y a un moyen pour ne pas modifier dans le code à chaque fois est de faire l'opération de façon automatique pour toutes colonnes une fois la macro exécutée.
Merci infiniment pour votre retour.

Citation:

Envoyé par Faicel.93

J'ai modifié la macro RemplirLesCellulesVides. En effet, lorsqu'on avait 0, rien ne se dupliquait. En revanche, le reste était bon. J'en ai déduit que les cellules restant vides ne pouvaient correspondre qu'à des 0. Il y a donc une deuxième boucle à la fin pour traiter ce cas.
Quant à traiter X colonnes, il suffit de rajouter une boucle dans TestRemplirLesCellulesVides

Code:

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
 
Sub RemplirLesCellulesVides(ByVal FeuilleEnCours As Worksheet, ByVal LigneDeTitre As Long, ByVal LigneLimite As Long, ByVal ColonneEnCours As Long)
 
Dim DerniereLigne As Long, LigneEnCours As Long
Dim ValeurEnCours As Variant
 
        With FeuilleEnCours
             DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
             If DerniereLigne < LigneLimite Then LigneLimite = DerniereLigne
 
             ' Initialisation de ValeurEnCours
             Select Case .Cells(LigneDeTitre + 1, ColonneEnCours).Value
                    Case ""
                        ValeurEnCours = "Sans info"
                        .Cells(LigneDeTitre + 1, ColonneEnCours) = ValeurEnCours
 
                    Case 0, "0"
 
                   Case Else
                         ValeurEnCours = .Cells(LigneDeTitre + 1, ColonneEnCours)
             End Select
             ' 1er balayage pour mettre à jour les valeurs "" avec ValeurEnCours
             ' les valeurs 0 ne sont pas prises en compte
             For LigneEnCours = LigneDeTitre + 1 To LigneLimite
                 Select Case .Cells(LigneEnCours, ColonneEnCours)
                        Case ValeurEnCours
 
                        Case ""
                             .Cells(LigneEnCours, ColonneEnCours) = ValeurEnCours
                        Case Else
                             ValeurEnCours = .Cells(LigneEnCours, ColonneEnCours)
                    End Select
             Next LigneEnCours
             ' 2ème balayage pour mettre à jour les valeurs 0
             For LigneEnCours = LigneDeTitre + 1 To LigneLimite
                 Select Case .Cells(LigneEnCours, ColonneEnCours)
                        Case ""
                             .Cells(LigneEnCours, ColonneEnCours) = 0
                 End Select
             Next LigneEnCours
        End With
 
End Sub
 
Sub TestRemplirLesCellulesVides()
 
Dim MaLigneDeTitre As Long, MaLigneLimite As Long, MaColonneEnCours As Long
 
    MaLigneDeTitre = 1
    MaLigneLimite = 8000
   ' MaColonneEnCours = 7
 
    For MaColonneEnCours = 1 To 7  ' A adapter 
    RemplirLesCellulesVides ActiveSheet, MaLigneDeTitre, MaLigneLimite, MaColonneEnCours
 
    Next MaColonneEnCours
 
End Sub

16/08/2017, 14h12
Faicel.93

Merci Erik pour votre retour. En revanche, moi je voulais qu'il ne recopie pas les cases vides mais pour les zéros je voulais qu'il les considèrent comme les autres valeurs et les recopie, par conséquent, les "" ne doivent pas être recopiés, mais par contre les "0" doivent l'être.
Et merci beaucoup Erik pour votre aide ! :)
16/08/2017, 14h18
Invité

Citation:

Envoyé par Faicel.93

En revanche, moi je voulais qu'il ne recopie pas les cases vides mais pour les zéros je voulais qu'il les considèrent comme les autres valeurs et les recopie, par conséquent, les "" ne doivent pas être recopiés, mais par contre les "0" doivent l'être.

????

Un exemple Avant-Après dans vidage d'écran s'impose.
16/08/2017, 14h50
Faicel.93

2 pièce(s) jointe(s)

Pièce jointe 303354 Pièce jointe 303355 Pièce jointe 303354 Pièce jointe 303355

Voilà, j'ai aussi fait une petite modification dans votre code afin d'afficher "" au lieu de "sans infos" et ça donne les résultats ci-dessus : les "" ainsi que les autres valeurs sont recopiés, mais pas les "0". Merci par avance.
16/08/2017, 14h59
Invité

Citation:

Envoyé par Faicel.93

Sur une capture partielle (tes vidages sont inexploitables), peux-tu expliquer avec des commentaires tes différents cas (cas par cas), que prends-tu en référence au départ, ce que tu veux obtenir au final.

Mets un fichier à disposition en expliquant tes différents cas sur un onglet différent.
16/08/2017, 15h15
Faicel.93

1 pièce(s) jointe(s)

Merci pour votre réponse. Je serais quand même obligé de vous montrer une capture d'écran pour mieux illustrer.
Dans ce tableau par exemple, je veux que pour toutes les colonnes , les valeurs soient recopiées vers le bas ( "", "0", ou toute autre valeurs, sauf l'entête ).
Le problème dans le code que vous'avez posté est que toutes les valeurs sont recopiées y compris les "", mais le seul problème c'est qu'il considérait les "0" comme des "" du coup il ne les recopie pas.
Pièce jointe 303374

Citation:

Envoyé par Faicel.93

Code:

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
 
Sub RemplirLesCellulesVides(ByVal FeuilleEnCours As Worksheet, ByVal LigneDeTitre As Long, ByVal LigneLimite As Long, ByVal ColonneEnCours As Long)
 
Dim DerniereLigne As Long, PremiereLigne As Long, LigneEnCours As Long
Dim ValeurEnCours As Variant
 
        With FeuilleEnCours
             DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
             If DerniereLigne < LigneLimite Then LigneLimite = DerniereLigne
             For LigneEnCours = LigneDeTitre + 1 To DerniereLigne
                 If .Cells(LigneEnCours, ColonneEnCours) <> "" Then
                     PremiereLigne = LigneEnCours
                     ValeurEnCours = CStr(.Cells(PremiereLigne, ColonneEnCours))
                     Exit For
                  End If
             Next LigneEnCours
             For LigneEnCours = PremiereLigne To LigneLimite
                 Select Case CStr(.Cells(LigneEnCours, ColonneEnCours))
                        Case ValeurEnCours
 
                        Case ""
                             .Cells(LigneEnCours, ColonneEnCours) = ValeurEnCours
                        Case Else
                             ValeurEnCours = .Cells(LigneEnCours, ColonneEnCours)
                    End Select
             Next LigneEnCours
        End With
End Sub
 
 
Sub TestRemplirLesCellulesVides()
 
Dim MaLigneDeTitre As Long, MaLigneLimite As Long, MaColonneEnCours As Long
 
    MaLigneDeTitre = 1
    MaLigneLimite = 8000
 
    For MaColonneEnCours = 1 To 3
        RemplirLesCellulesVides ActiveSheet, MaLigneDeTitre, MaLigneLimite, MaColonneEnCours
    Next MaColonneEnCours
 
End Sub

16/08/2017, 17h52
Faicel.93

Merci infiniment Erik ça a fonctionné parfaitement ! :merci: