cel vullen nav x-jes

[popipipo]

In een tabel heb ik verschillende x-jes staan.
In één cel wil ik alle kolomkopnamen onder elkaar hebben staan waarin het x-je staat.

 

[Cobbe]

Deze rudimentaire code doet dat voor u:

Sub test()
  For y = 2 To Range("A65500").End(xlUp).Row
    For i = 5 To 10
        If Cells(y, i) <> "" Then
            result = result & Cells(1, i) & Chr(10)
        End If
    Next
Cells(y, 3) = result
result = ""
Next
End Sub

 

[popipipo]

Om nog even het puntje op de i te krijgen zou ik nog graag de laatst 'Chr(10)' weg willen hebben.
Voor de rest doet de code precies wat ik wil. :thumb:

Lukt het niet dan schrijven we de i gewoon met een hoofdletter, daar staat nl geen punt op.

 

[zapatr]

popipo,
wijzig deze regel:

Cells(y, 3) = result

in:

Cells(y, 3) = Left(result, Len(result) - 1)

Best ook de variabelen y, i, en result aan het begin van de macro declareren.

 

[Cobbe]

En nu zonder de laatste Chr(10):

Sub test()
On Error Resume Next
For y = 2 To Range("A65500").End(xlUp).Row
    For i = 5 To 10
        If Cells(y, i) <> "" Then
            result = result & Cells(1, i) & Chr(10)
        End If
    Next
  result = Left(result, Len(result) - 1)
Cells(y, 3) = result
result = ""
Next
End Sub

 

[popipipo]

Dit was dus het puntje op de i
Beide hartelijk dank.

 

[Warme bakkertje]

Je schrijft dat het meerdere kolommen kunnen worden.

For i = 5 To Cells(2, 1).CurrentRegion.Columns.Count