Remplir la cellule grâce à la ligne d'en dessous

Bonjour à Tous,

J'ai de nouveau un problème donc je viens me tourner vers vous, j’espère que vous pouvez m'aider.

Tout est dans le titre : dans ma colonne j'ai des valeurs et des fois il y a des trous.

je veux juste utiliser la cellule d'en dessus pour combler ce trou

Voici ma formule

Sub remplir_si_0()

Dim wb As Workbook

Dim ws As Worksheet

Dim c As Range

Set plage = Range("B2:B33")

For Each wb In Workbooks

For Each ws In wb.Worksheets

For Each c In Range("B2:B33")

If c.Value <> "" Then

c.Value = c.Offset(-1, 0).Value

End If

Next c

Next ws

Next wb

End Sub

Le problème c'est que ça tourne en rond, je penses que la méthode est bonne mais l'écriture non.

Si vous trouver je suis preneur

Merci d'avance

Salut Hugo,

sans fichiers, difficile de vraiment être sûr...

  • neutraliser l'actualisation de l'affichage ;
  • remplir la cellule si elle est vide, je suppose, donc
Sub remplir_si_0()

Dim wb As Workbook
Dim ws As Worksheet
Dim c As Range, plage As Range
'
Set plage = Range("B2:B33")
'
Application.ScreenUpdating = False
For Each wb In Workbooks
    For Each ws In wb.Worksheets
        For Each c In plage
            If c.Value = "" Then c.Value = c.Offset(-1, 0).Value
        Next 
    Next
Next
Application.ScreenUpdating = True
'
End Sub

A voir...

A+

Bonsoir,

très bonne réponse, curulis57, avec une exception à rajouter : Contrôler que B1 est une valeur.

 Sub remplir_si_0()

Dim wb As Workbook
Dim ws As Worksheet
Dim c As Range, plage As Range
'
Set plage = Range("B2:B33")
'
Application.ScreenUpdating = False
For Each wb In Workbooks
    For Each ws In wb.Worksheets
        For Each c In plage
            If c.Value = "" and  c.Offset(-1, 0).Value= "" Then       'si dessus vide, message.
                         Application.ScreenUpdating = True
                         msgbox "Pas de valeur valide ci-dessus.", vbcritical
                         cells(c.row, c.column).activate
                         exit sub
            end if
            If c.Value = "" Then c.Value = c.Offset(-1, 0).Value
        Next
    Next
Next
Application.ScreenUpdating = True
'
End Sub

Bonjour,

Pour le principe.

A adapter et il faut évidemment que les cellules soient vides.

Cdlt.

Public Sub DEMO()
Dim rng As Range
    With ActiveSheet
        On Error Resume Next
        Set rng = .Range("B2:B33").SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
    End With
    If Not rng Is Nothing Then
        With rng
            .FormulaR1C1 = "=R[-1]C"
            .Value = rng.Value
        End With
    End If
End Sub
Rechercher des sujets similaires à "remplir ligne dessous"