gegevens uit verschillende kolommen onder elkaar naar 1 kolom verplaatsen.

[backnext]

Hallo,
Ik wil de gegevens in een aantal kolommen die nu dus naast elkaar staan onder elkaar krijgen in 1 kolom.
Alles in kolom B netjes onder het laatste gegeven van kolom A en kolom C ook daaronder enzovoort.
De cellen moeten dus niet samengevoegd worden. Kan het bij voorkeur met een formule (ik heb excel 2010)?
Er zijn gemiddeld 20 tot 50 rijen en 10 tot 15 kolommen. Transponeren zou telkens wel lukken maar ik wil dit automatisch regelen.

 

[gast0660]

Hoi,
Welkom op dit forum
Een tip voor de volgende keer, post een vb bestandje (zonder gevoelige info)
Maar mischien zoiets ?
Zie bijlage

 

[backnext]

Da's rap

Bedankt gast0660, Je voorbeeld komt volledig overeen met wat ik bedoel.
Als ik op de testknop druk krijg ik een waarschuwing: "De macro "Kolommen naar één kolom-1.xlsb'!TableToColumn kan niet worden uitgevoerd. De macro is wellicht niet beschikbaar in dit werkblad of alle macro's zijn mogelijk uitgeschakeld." Dat laatste is zeker niet het geval. Ik gebruik veel macro's. Vreemd.
Als ik de macro uitvoer via Macro's/Dotchie/uitvoeren, dan lukt het. (bereik een beetje aangepast om alle gegevens mee te hebben).
Ziet er mooi uit. Ik moet de VBAcode nog eens op 't gemak bekijken om alles te begrijpen maar dat is wat ik zocht. Hoe zou het komen dat de testknop hier niet werkt?

 

[gast0660]

Hoi,
Je moet gewoon mijn vbtje vertrouwen , inschakelen

 

[Timshel]

Ik zag dat Dotchies macro nog niet gekoppeld was aan het knopje.
Nog een alternatief:

Sub tsh()
    Dim i
    
    For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
        Columns(i).SpecialCells(2).Cut Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next
End Sub

 

[backnext]

Dotchie, Philiep, Ik heb alle vertrouwen in jou werk. Dus ook "macro vertrouwen" aangeklikt...
Ik vond die van Dotchie al heel mooi.
Timshel, Die van jou is nog beknopter. Shakespeare kan wel eens gelijk hebben :d
Werkt heel vlot maar in enkele kolommen heb ik lege cellen. Daar stopt de macro. Moet ik die eerst opkuisen of bestaat er een beknopte manier om dit in jou macrootje te verwerken?
In ieder geval bedankt. Dat spaart me heel wat zoekwerk uit.

 

[VenA]

Plaats een eigen voorbeeldje dat werkt over het algemeen wat beter. En anders de .spcialcells(2) uit de code van Timshel weghalen.

Nog een andere optie die mogelijk ook kan werken.

Sub VenA()
With Sheets(1)
    ar = .Cells(1).CurrentRegion
    For j = 1 To UBound(ar)
        For jj = 1 To UBound(ar, 2)
            c00 = c00 & "|" & ar(j, jj)
        Next jj
    Next j
    .[P1].Resize(UBound(Split(Mid(c00, 2), "|"))) = Application.Transpose(Split(Mid(c00, 2), "|"))
End With
End Sub

 

[Timshel]

Dan moet het net even anders:

Sub tsh()
    Dim i
    
    For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
        Cells(1, i).Resize(Cells(Rows.Count, i).End(xlUp).Row).Cut Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next
End Sub

 

[backnext]

VenA, ook bedankt. Dat probeer ik straks eens.
Timshel, nog steeds probleem met lege cellen. Ik heb een voorbeeldje in bijlage.Bekijk bijlage beknopteMacro_4.xlsm

met selecteren speciaal/lege waarden/ verwijderen lukt het wel maar dat is niet zo elegant.

 

[Timshel]

Volgende poging Volgens mij moet zo alles worden meegenomen.

Sub beknoptmacro()
'
' beknoptmacro Macro
'
' Sneltoets: Ctrl+b
'
Dim i
    For i = 2 To ActiveSheet.UsedRange.Columns.Count
        Cells(1, i).Resize(Cells(Rows.Count, i).End(xlUp).Row).Cut Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next
End Sub

 

[backnext]

Dit gaat snel, kan bijna niet volgen.
VenA: werkt ook heel vlot maar in de kolom komen de lege cellen nu ook voor. Dit kan ik wel oplossen met selecteer speciaal... maar wat vreemd is, is dat de allerlaatste cel wegvalt... In mijn voorbeeld is Peter1 rechtsonder er niet meer bij na de macro. Enig idee?

 

[HSV]

Staan er ook wel getallen in de cellen, anders worden getallen ineens tekst.
In onderstaande code blijven dat getallen.

Sub hsv()
Dim sn, arr, cc As Long, y As Long, j As Long, jj As Long
With Sheets(1)
    sn = .Cells(1).CurrentRegion
    cc = .UsedRange.Cells.Count
 ReDim arr(cc)
    For jj = 2 To UBound(sn, 2)
        For j = 1 To UBound(sn)
          If sn(j, jj) <> "" Then
             arr(y) = sn(j, jj)
            y = y + 1
          End If
        Next j
    Next jj
 .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(cc) = Application.Transpose(arr)
 .Cells(1).CurrentRegion.Columns(2).Resize(, UBound(sn, 2) - 1).ClearContents
End With
End Sub

 

[backnext]

HSV, De getallen die aan de namen gekoppeld staan in de kolommen mogen als tekst behandeld worden. Ik bekijk jou macro zeker straks. Bedankt.
Timshel, Dit werkt inderdaad. Alle kolommen worden nu meegenomen. In de kolom die dan gevormd wordt staat alles netjes onder elkaar. De lege cellen staan er ook wel nog tussen maar die haal ik er dan wel uit met selecteer speciaal/lege waarden/verwijderen...
Ik bevind me hier in het gezelschap van superprofs.

 

[Timshel]

... maar die haal ik er dan wel uit met selecteer speciaal/lege waarden/verwijderen...

Welnee.

Sub beknoptmacro()
'
' beknoptmacro Macro
'
' Sneltoets: Ctrl+b
'
Dim i
    For i = 2 To Cells(1).CurrentRegion.Columns.Count
        Cells(1, i).Resize(Cells(Rows.Count, i).End(xlUp).Row).Cut Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next
    Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Delete xlUp
End Sub

 

[backnext]

HSV,
Je macro werkt super, zeer snel, geen spaties. Perfect voor mijn kolommetjes.
Meer moet dat niet zijn. Heel erg bedankt maar ondertussen zie ik er nog eentje toekomen, die check ik ook even.

 

[backnext]

Timshel,

Nu is ie perfect. En een heel beknopte mooie macro.
Ik heb de indruk dat die van HSV iets vlugger werkt en dat van die getallen die getallen blijven moet ik nog eens uittesten.
Maar welke hier de eerste prijs haalt laat ik aan de specialisten over.
Nog eens bedankt allemaal.

 

[Timshel]

Is goed hoor succes ermee.
Zet je de vraag nog even op opgelost?

 

[backnext]

jep, thanx