Macro - Remplissage auto selon conditions

Bonjour à toutes et à tous !

Pour le contexte : j'ai développé un script Powershell permettant de récupérer/parser les donnés d'un rapport au format HTML. Quand je l’exécute, toutes les données "utiles" atterrissent dans un fichier Excel. Cependant, pour plus de clarté et afin d'intégrer tout cela dans un référentiel, j'aurais besoin d'appliquer une certaines mise en forme. Avec mes mots, ça donne ça :

"- IF cellule vide AND IF toutes les cellules à sa gauche sont vides : copier cellule du dessus"

"- IF cellule vide AND IF valeur présente dans au moins une cellule à sa gauche : ne rien faire"

Il faudrait aussi que cette macro s’exécute de la colonne H vers A (de droite à gauche en quelque sorte).

Pour plus de clarté, en PJ vous trouverez deux fichiers : celui d'origine, et le résultat attendu. J'ai bien entendu essayé beaucoup de choses, mais je n'y arrive pas En attendant, je fais tout à la main avec la macro suivante :

[b]Public Sub FillBlanks()

Dim rColumn As Range

Dim rCell As Range

If TypeName(Selection) = "Range" Then

For Each rColumn In Selection.Columns

For Each rCell In rColumn.Cells

If rCell.Row > rColumn.Cells(1).Row Then

If IsEmpty(rCell.Value) Then

rCell.Value = rCell.Offset(-1).Value

End If

End If

Next rCell

Next rColumn

End If

End Sub[/b]

Mais suivant la taille du tableau, ça peut prendre beaucoup de temps

Merci d'avance pour votre aide.

Cordialement.

Bonjour,

Une piste à adapter. Le résultat est légèrement différent car suppression des lignes vides :

Sub Test()

    Dim Plage As Range
    Dim Lig As Range
    Dim Cel As Range
    Dim CelLig As Range
    Dim CelDebut As Range
    Dim I As Long

    'défini la plage sur toute la feuille à partir de A1
    Set Plage = DefPlage(ActiveSheet)

    'supprimle toutes les lignes vides
    For I = Plage.Rows.Count To 1 Step -1

        If Application.CountA(Plage.Rows(I)) = 0 Then Plage.Rows(I).EntireRow.Delete

    Next I

    'redéfini la plage
    Set Plage = DefPlage(ActiveSheet, 1, 2)

    'boucle sur les cellules de la colonne J
    For Each Cel In Plage.Columns(9).Cells

        'si pas vide...
        If Cel.Value <> "" Then

            'boucle sur les cellules de la ligne en cours
            For Each CelLig In Range("B" & Cel.Row & ":H" & Cel.Row)

                'et si ce n'est pas la colonne H tire vers le bas
                If CelLig.Column <> 8 Then

                    Set CelDebut = CelLig.End(xlUp)
                    CelDebut.AutoFill Range(CelDebut, CelLig)

                Else 'sinon

                    'vérifie la valeur de la cellule située 2 colonnes à gauche et 1 ligne au dessus
                    'tire vers le bas si elle n'est pas vide
                    If Cel.Offset(-1, -2).Value <> "" Then

                        Set CelDebut = CelLig.End(xlUp)
                        CelDebut.AutoFill Range(CelDebut, CelLig)

                    End If

                End If

            Next CelLig

        End If

    Next Cel

End Sub

Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range

    On Error GoTo Fin

    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With

    Exit Function

Fin:

    Set DefPlage = Nothing

End Function

Bonjour et merci beaucoup pour ta réponse.

Finalement, entre temps, j'ai reçu de l'aide, voici le résultat final, répondant à 100% de mes besoins :

Sub FillBlanks()
    I = 1 ' i est initialisé au numéro de la première ligne du tableau
    j = 8 ' j est initialisé au numéro de la dernière colonne du tableau
    ' BasDePage = 540 ' Le numéro de la dernière ligne est fixé dans le code
    DerniereLigne = Range("J1").SpecialCells(xlCellTypeLastCell).Row

    ' Pour les colonnes de H vers A
    For j = 8 To 1 Step -1
        ' Pour chaque ligne
        For I = 1 To DerniereLigne
            ' Par défaut on considère que la ligne est vide
            LigneVide = True

            ' On commence à parcourir chaque colonne pour la ligne i
            k = j
            ' Tant que la ligne est toujours vide et qu'on n'est pas sur la première colonne (A)
            While LigneVide = True And k >= 2
                If Not (IsEmpty(Cells(I, k))) Then
                    ' Si la ligne n'est pas vide, on positionne le flag à Faux
                    LigneVide = False
                End If
                ' On passe à la colonne suivante
                k = k - 1
            Wend

            ' Si la ligne est vide
            If LigneVide = True Then
               ' Et si on n'est pas sur la première ligne
                If I > 1 Then
                    ' Alors on copie dans la cellule ciblé la valeur de la cellule du dessus
                    Cells(I, j) = Cells((I - 1), j)
                End If
            End If
        Next I
    Next j

End Sub