Rijen omzetten naar kolommen - kolom A behouden

[Adriaanse]

Hallo,

Ik wil graag een aantal cellen in een rij omzetten naar een kolom, zie hieronder (en in de bijlage een uitbreid voorbeeld)
010 G ZAANSTAD 5673 5674

Wens:
010 5673
010 5674

Ik hoop dat iemand mij kan helpen met een macro.Bekijk bijlage Rijen omzetten naar kolommen.xlsx

 

[Cobbe]

Hier een rudimentaire macro die dat voor u doet:
Wel op hetzelfde blad vanaf rij 20; maar dat moet geen probleem vormen:

Sub cobbe()
rij = 20
For Each cl In Range("C2:C14")
 Cells(rij, 3) = cl
  For kol = 6 To 26
   If Cells(cl.Row, kol) <> "" Then
    Cells(rij, 3) = cl
    Cells(rij, 4) = Cells(cl.Row, kol): rij = rij + 1
   End If
  Next
 Next
End Sub

 

[HSV]

Of alles in een array gooien wat zeker sneller moet werken dan steeds naar het blad verwijzen.
Beetje vreemd dat je begint in kolom C.

Sub hsv()
Dim sn, arr, i As Long, j As Long, n As Long
With Sheets("bron")
sn = .Cells(1).CurrentRegion.Offset(, 2)
ReDim arr(UBound(sn) * UBound(sn, 2), 1)
    For i = 2 To UBound(sn)
      For j = 4 To .Cells(i, Columns.Count).End(xlToLeft).Column - 2
        arr(n, 0) = sn(i, 1)
        arr(n, 1) = sn(i, j)
                n = n + 1
      Next j
    Next i
 End With
 With Sheets("wens")
  .Columns(1).NumberFormat = "@"
  .Cells(1).Resize(n, 2) = arr
 End With
End Sub

 

[Cobbe]

Ja heb de regels zeker niet goed gelezen.

Het staat er toch bij.

 

[HSV]

Het spijt me, maar ik kan je niet volgen Cobbe.

 

[Adriaanse]

Super bedankt!!