Répliquer une ligne sur plusieur sans incrémentation en VBA

Bonjour à toute et tous j'aurais besoin d'un coup de main
Pour excel 2016 j'ai un fichier qui aura beaucoup de colonnes et qui fait facilement 5 à 6000 lignes sur plus d'une 50 aines de colonnes.
Que je vais devoir traiter chaque mois...

Par la suite, J'ai besoin de faire un tris avec les filtres de la mise en forme sous tableau.
Cependant mon tris est impossible à faire si je n'ai pas les lignes de la colonne A à F qui se répliquent (sans incrémentation).
Les lignes vides sont aléatoires et possèdent toutes un trait d'union.

J'aurais besoin que toute la ligne (Jaune de A à F) se réplique sans incrémentation jusqu'au prochain et que le prochain se complète et ainsi de suite.
Vu le nombre de lignes à remplir, étirer ce qui me manque sur 6000 lignes me prend un temps de dingue...
d’où l’importance de pouvoir remplir automatiquement ou avec un bouton les vides (-)

Quelqu'un peut il m'aider pour cela ?

Je vous joint le fichier Excel

Merciii pour votre aide :)

bonsoir,

une proposition via une macro

Sub aargh()
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        tb = .Range("A1").Resize(dl, 6)
        For i = 1 To dl
            If tb(i, 1) = "-" Then
                For j = 1 To 6
                    tb(i, j) = tb(i - 1, j)
                Next j
            End If
        Next i
        .Range("A1").Resize(dl, 6) = tb
    End With
End Sub

bonjour Oceanina, salut h2so4,

une autre proposition,

Sub Oceanina()
     With Sheets("Feuil1").UsedRange
          With .Offset(2).Resize(.Rows.Count - 2)     'à partir de la ligne 3, toutes les lignes
               .Replace "-", "", xlWhole     'supprimer les "-"
               .SpecialCells(xlBlanks).FormulaR1C1 = "=if(len(R[-1]C),R[-1]C,"""")"     'ajouter une formules aux cellules vides
               .Value = .Value               'remplacer formules par leur valeur
          End With
     End With
End Sub

Hello voici le retour sur les 2 codes que j'ai reçu.
Je n'ai pas réussi à faire fonctionner le 2e code et le premier fonctionne en partie car il transforme mes données de base après la réplication...
Sauf que les Données de bases je ne peux absolument pas y toucher.

Je vous joint un 2e fichier Excel.
(la Page BASE est le fichier de départ il ne peut absolument pas se modifier lors de la réplication. Toutes les données doivent rester "Standard" cad tel que je le reçois).

Merci beaucoup pour votre aide :)

2023 12 16 21h56 44

re, la macro "Oceania", MAIS, le vrai problème se pose un moment plus tôt. Je pense que vous avez reçu un fichier TXT ou CSV et que vous l'avez déjà importé dans excel et puis ... . Donnez-nous ce fichier CSV ou TXT (quelque lignes suffit)

Bonjour le fichier n'arrive pas en CSV il m'arrive en version "Classeur Excel 97- 2003(*.xls)"
Ensuite ce que je fais (avant de faire mon tris manuel actuellement) c'est de l’enregistrer dans une version excel plus récente qui accepte les macro.

Le fichier d'orgine arrive avec des nombres qui sont vu par Excel en texte car j'ai un petit triangle rouge sur chaque code et donc les dates n'ont pas de format de date mais un format standard.

2023 12 17 08h28 47

C'est un fichier confidentiel je ne peux donc que partager un exemple avec des données anonymisées.

re,

nouvel essai dans la feuille "2e code"

J'ai testé en mettant une valeur aux colonnes 'date entrée - Mise au frigo et Sortie frigo' : La réplication fonctionne beaucoup mieux mais...
Pour la date entrée c'est OK
Pour les 2 autres colonnes comme j'ai du mettre un format et que j'ai des centièmes de secondes... j'ai mettre ceci (Mise au frigo) aaaa-mm-jj hh:mm:ss,00
Dans la mise au foramt personnalisée je ne peux mettre de point Excel refuse j'ai donc du mettre une virgule.

Cependant sur mon fichier d'origine je n'ai pas virgule mais un point ( 2023-11-03 10:10:00.00) d'autre colonnes ont (2023-11-05 12:46:03.245) ... La colonne "Sortie frigo" a plus de chiffres après le point... ce qui va me poser souci car plus loin dans mon fichier j'aurai des date sans virgule mais avec un point... si un autre comparatif dois encore se faire il sera impossible.

Ce fichier après mon traitement aura une 2e destination ou les personnes qui vont le recevoir vont en faire des tableaux dynamiques mais je ne sais pas ce qu'il vont traiter comme données.

2023 12 17 08h52 14

Au moment ou j'ai ecris ce message j'ai reçu un autre code qui l'air de fonctionner je dois encore le tester dès que je peux l'ouvrir je le teste et je reviens mettre un feedback.

Je viens de tester sur la page mais il replique aussi les boutons.

Pour tester j'ai oter les ligne remplie et j'ai remis des trait union et quand j'ai active le bouton il repliquer aussi les boutons.
Sinon cela a l'air de fonctionner

2023 12 17 09h52 00

Est ce que le code est celui ci ?

image

re,

plus tard, ce n'est que la 2e partie qui vous aurez besoin

Sub Oceanina()
     Dim Ar

     'PREPARATION = COPIER ET COLLER "BASE"
     Sheets("2e code").Cells.Clear
     Application.Wait Now + TimeSerial(0, 0, 1)
     Sheets("base").Range("A1").CurrentRegion.Copy Sheets("2e code").Range("A1")     '.PasteSpecial xlValues
     Application.Wait Now + TimeSerial(0, 0, 1)

     'LA MACRO ELLE-MEME
     Application.ScreenUpdating = False
     With Sheets("2e code").UsedRange
          .Columns(1).Replace "-", "", xlWhole
          For Each Ar In .Columns(1).SpecialCells(xlBlanks).Areas
               Ar.Cells(0, 1).EntireRow.Copy Ar
           Next
     End With
      Application.ScreenUpdating = True
End Sub

re,

Sub Methode2()
     aA = Sheets("base").Range("A1").CurrentRegion.Value
     For j = 1 To UBound(aA, 2)
          For i = 2 To UBound(aA)
               If aA(i, j) <> "-" Then
                    If aA(i, j) Like "##/##/####" Then
                         sp = Split(aA(i, j), "/")
                         Valeur = --DateSerial(sp(2), sp(1), sp(0))
                    ElseIf aA(i, j) Like "####-##-## ##:##:##*" Then
                         sp = Split(Replace(aA(i, j) & ".000", ".", " "))
                         Valeur = CDbl((DateValue(sp(0)) + TimeValue(sp(1)) + Left(sp(2), 3) / 86400000))
                    ElseIf IsNumeric(aA(i, j)) Then
                         Valeur = "'" & aA(i, j)
                    Else
                         Valeur = aA(i, j)
                    End If
               End If
               aA(i, j) = Valeur
          Next
     Next

     With Sheets("2e code")
          .Cells.Clear
          .Range("A1").Resize(UBound(aA), UBound(aA, 2)).Value = aA
          .Columns("D").NumberFormat = "dd/mm/yyyy"
          .Range("E:F").NumberFormat = "dd/mm/yyyy hh:mm:ss.000"
     End With

End Sub
Rechercher des sujets similaires à "repliquer ligne incrementation vba"