Regrouper plusieurs colonnes en une seule colonne

Bonjour,

Je suis nouvelle, je sais que le sujet à été déjà abordé mais mon besoin est un peu particulier d'autant plus que je ne connais pas les macros, donc je suis débutante.

en pj un onglet de ce que j'ai et un deuxième du résultat souhaité.

Merci

62colonne.xlsx (13.72 Ko)

bonjour

pas beaucoup de candidat (vu le binz )

une reponse partielle (et; c'est deja pas mal ) pour le reste ????? ou alors .......

sans vba

61yosraga.xlsx (27.83 Ko)

cordialement

ps: ne cherche pas trop à "decortiquer" le procedé

tu peux rajouter des lignes dans actuel

Bonsoir tulipe_4, yosraga

Essaie ceci, restitution en Feuil1 préalablement créée

Option Explicit
Sub test()
Dim a, b(), i As Long, n As Long, j As Long, k As Byte
    Application.ScreenUpdating = False
    a = Sheets("actuel").Range("A1").CurrentRegion.Value
    ReDim b(1 To (((UBound(a, 2) - 23) / 2) * (UBound(a, 1) - 1)) + 1, 1 To 24)
    n = 1
    For j = 2 To 25
        b(n, j - 1) = a(1, j)
    Next
    For i = 2 To UBound(a, 1)
        For j = 24 To UBound(a, 2) Step 2
            If a(i, j) <> "" Then
                n = n + 1
                For k = 2 To 23
                    b(n, k - 1) = a(i, k)
                Next
                b(n, 23) = a(i, j)
                b(n, 24) = a(i, j + 1)
            End If
        Next
    Next
    'Restitution et mise en forme en Feuil1
    With Sheets("Feuil1")
        .Cells.Clear
        With .Range("A1").Resize(n, UBound(b, 2))
            .Value = b
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .Interior.ColorIndex = 44
                .HorizontalAlignment = xlCenter
            End With
            .Font.Name = "calibri"
            .Font.Size = 10
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .VerticalAlignment = xlCenter
            '.HorizontalAlignment = xlCenter
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour Klin89, tulipe_4,

Merci Pour vos réponses, vous me sauvez

@Klin89, quand j'ai exécuté sur le fichier que je vous ai envoyé c'est ok, par contre quand j'ai fait le RUN sur le fichier en question j'ai eu une erreur "erreur d’exécution 13" incompatibilité.

J'ai modifié dans le code a = Sheets("actuel") par le nom du sheet.

Est-ce qu'il y a autre chose à modifier ?

Merci encore une fois

Rechercher des sujets similaires à "regrouper colonnes seule colonne"