Copier une valeur jusqu'à une cellule non vide

Bonjour,

J'essaie désespéremment de faire une manipulation qui je pense est très simple en terme de macro mais que je n'arrive pas à faire.

J'ai un logiciel qui m'extrait mes articles en me laissant des cellules vides tant que les lignes correspondent à mon article. (exemple fichier ci-joint)

J'aimerais trouver une macro qui me répète mon article et mon libellé d'article tant que les cellules sont vides. Puis qu'elle recopie la nouvelle ligne article jusqu'à rencontrer une troisième etc...

Par exemple dans le fichier mon premier article est le 101 Avocat. J'aimerais que la macro copie mon numéro 101 de la ligne 2 à la ligne 5, puis mon code 102 de la ligne 7 à 8, puis le code 106 de la ligne 13 à 15, etc....

Le fichier complet comporte plus de 8000 lignes et je ne me vois pas les recopier à la main.

Merci d'avance.

Bonsoir

Il y a des cellules paraissant vides qui ne le sont pas : Elle contiennent des espaces

Voir par exemple A14 et C14

A tester et à bien vérifier

Bonsoir,

^^ Des espaces...

Cela fais 20 min que je cherche une solution, j'ai pas pensé à vérifier les espaces

J'avais ça sinon à proposer

Sub EAN()

Dim DerLig As Long
Dim Lig As Long

DerLig = Range("A1048576").End(xlUp).Row

For Lig = 2 To DerLig

If Range("A" & Lig).Value = "" Then
Range("A" & Lig).Value = Range("A" & Lig - 1).Value
End If

Next

End Sub

Edit:

Merci Sophie85 et Banzai64

Ca m'a permis d'apprendre à tester si c'est une valeur numérique ou non

If Not (IsNumeric(Range("A" & Lig))) Then
Range("A" & Lig).Value = ""

Bonsoir Harissa23, Banzai64, Sophie85, le forum

Effectivement, tes données sont importées, il faut commencer par un bon coup de nettoyage

A tester sur la feuille concernée.

Sub Remplir()
Dim myAreas As Areas, myArea As Range, e
    With [A1:E166]
        .Value = [index(trim(clean(A1:E166)),)]
    End With
    Range("F2:F" & Range("A" & Rows.Count).End(xlUp).Row) = 1
    On Error Resume Next
    Set myAreas = Range("f2", Range("f" & Rows.Count).End(xlUp)).SpecialCells(2).Areas
    If Not myAreas Is Nothing Then
        For Each myArea In myAreas
            For Each e In Array("a", "c")
                With myArea.EntireRow.Columns(e)
                    .SpecialCells(4).Formula = "=r[-1]c"
                    .Value = .Value
                End With
            Next
        Next
    End If
    Columns("f").Delete
    Set myArea = Nothing
End Sub

klin89

Bonjour,

Merci beaucoup à vous tous, vous me proposez que des choses qui ont fonctionné sur mon fichier de 8000 lignes.

Je revis, je les garde toutes précieusement car ces extractions sont quotidiennes !

Re Sophie85

A tester cette autre version :

Sub Remplir2()
Dim tablo As Variant, i As Byte, derl As Long
    Application.ScreenUpdating = False
    tablo = [{"A","C"}]
    derl = Cells.SpecialCells(11).Row
    With ActiveSheet.UsedRange
        .Value = Evaluate("if(" & .Address & _
                          "<>"""",trim(clean(" & .Address & ")),"""")")
    End With
    On Error Resume Next
    For i = 1 To UBound(tablo)
        With Range(tablo(i) & 2 & ":" & tablo(i) & derl)
            .SpecialCells(4).Formula = "=R[-1]C"
            .Value = .Value
        End With
    Next i
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

klin89