Transformer plusieurs lignes en une ligne

maval

XLDnaute Barbatruc
Bonjour

J’ai dans mon fichier des valeurs « F » qui commence toutes par <polygon et ces valeurs sont sur plusieurs lignes j’aimerais les transformer sur une ligne, j’ai fait un modèle pour être plus explicite

je vous remercie
Max
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Re

un essai ici
VB:
Sub rassemble()
Dim TabIni() As Variant
With ActiveSheet
    Fin = .Range("G" & .Rows.Count).End(xlUp).Row
    TabIni = .Range("F5:G" & Fin).Value
    TailleFinale = WorksheetFunction.CountA(.Range("F5:F" & Fin))
    ReDim TabFinal(1 To TailleFinale, 1 To 1)
End With
k = 1
For i = LBound(TabIni, 1) To UBound(TabIni, 1)
    If TabIni(i, 1) <> "" Then
        TabFinal(k, 1) = TabIni(i, 1)
       
        j = i
       
        While TabIni(j + 1, 1) = "" And j <= Fin - 5
            TabFinal(k, 1) = TabFinal(k, 1) & "," & TabIni(j + 1, 2)
            j = j + 1
            If j = Fin - 4 Then GoTo recopie
        Wend
        k = k + 1
    End If
Next i
recopie:
With Sheets("Feuil2")
    .Range("A1").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal
    .Range("B:B").Clear
End With
End Sub
 

maval

XLDnaute Barbatruc
vgendron

Oui sa fonctionne mais j'ai une erreur en ligne
While TabIni(j + 1, 1) = "" And j <= Fin - 5

L'indice n'appartiens pas à la sélection
 

job75

XLDnaute Barbatruc
Bonsoir maval, vgendron,
Code:
Sub Concatener()
Dim tablo, resu(), i&, n&
With [F5].CurrentRegion
    tablo = .Resize(, 2)
    ReDim resu(1 To UBound(tablo), 1 To 1)
    For i = 1 To UBound(tablo)
        If tablo(i, 1) <> "" Then n = n + 1: resu(n, 1) = tablo(i, 1)
        If n Then resu(n, 1) = resu(n, 1) & tablo(i, 2)
    Next
    Application.ScreenUpdating = False
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    .ClearContents 'RAZ
    If n Then .Resize(n, 1) = resu 'restitution
    With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
End Sub
A+
 

Discussions similaires


Haut Bas