cellen van horizontaal naar vertikaal overbrengen

[Havana100]

Beste,

Iemand een idee hoe ik, zie voorbeeld file, de cellen in de eerste zeven rijen op een simpele manier kan verplaatsen naar de kolom AA. Of in cel AA1 zou de waarde van cel A1 moeten komen staan, in cel AA2 de waarde van cel B1, in cel AA3 de waarde van cel C1 .......... indien alle waarden van rij 1 ( tot en met cel X1) in kolom AA staan dan zou de waarde uit de cel A2 daarop moeten volgen enze.


bij voorbaat bedankt ! Bekijk bijlage voorbeeld.xlsx

 

[Ad Becude]

Zoals in je voorbeeldje staat, kun je kopiëren dan Plakken speciaal...transponeren.

 

[Havana100]

beste,

bedankt hoor, en het klopt inderdaad maar voor een paar rijen is dat nog te doen maar in totaal kunnen dat ongeveer een drie a vier honderd rijen zijn en dan is dat toch een heel gedoe!

 

[Havana100]

beste,

bedankt hoor, maar in kolom krijg ik nu 24 maal cel A1, dan 24 maal de cel A2. het zou echter moeten zijn : in cel AA1 de waarde van cel A1, in cel AA2 de waarde van Cel B1, in AA3 de waarde van cel C1 enz. De waarde van cel A2 zou dan moeten komen in cel AA25 enz.

 

[edmoor]

Probeer deze eens:

Sub Hor2Vert()
    Dim x As Long
    Dim y As Long
    Dim z As Long
    
    Application.ScreenUpdating = False
    z = 1
    With ActiveSheet
        For x = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
            For y = 1 To 24
                Range("AA" & z) = Cells(x, y).Value
                z = z + 1
            Next y
        Next x
    End With
    Application.ScreenUpdating = True
End Sub

 

[gast0660]

Zo?

 

[Jack Nouws]

of zoiets?

    For Each i In Cells(1).CurrentRegion
        Cells(Rows.Count, 27).End(xlUp).Offset(1) = i
    Next

 

[edmoor]

Keurig :thumb:

 

[HSV]

Of per 24 wegschrijven.

Sub transponeer()
Dim i As Long
 For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Cells(Rows.Count, 27).End(xlUp).Offset(IIf(Range("aa1") = "", 0, 1)).Resize(24) = Application.Transpose(Cells(i, 1).Resize(, 24).Value)
 Next i
End Sub

Of in een array inlezen en wegschrijven (qua snelheid maak niet veel verschil met de andere).

Sub in_array()
Dim sn, i As Long, j As Long
sn = Cells(1).CurrentRegion
ReDim arr(UBound(sn) * UBound(sn, 2))
 For i = 1 To UBound(sn)
   For j = 1 To UBound(sn, 2)
    arr(n) = sn(i, j)
     n = n + 1
    Next j
  Next i
 Range("aa1").Resize(UBound(arr)) = arr
End Sub

 

[popipipo]

Met een formule kan het ook

=INDEX($A$1:$X$7;COLUMN()-26;ROW())

 

[Havana100]

Allemaal !!!!

super hoor ! werkt perfect !!!!!

bedankt !!!!!

 

[pasan]

of deze met dank aan

Sub onderelkaar()
sn = WorksheetFunction.Transpose(ActiveSheet.Cells(1, 1).CurrentRegion)
 For i = 1 To UBound(sn, 1)
  Cells(Cells(Rows.Count, 5).End(xlUp).Row + 1, 5).Resize(UBound(sn, 2)) = Application.Transpose(Application.Index(sn, i, 0, 1))
 Next
End Sub