Datenblöcke in Spalte A in mehrere Spalten aufteilen

Moin,

ich habe folgende Tabelle:

buchstaben
a
b
c
d

zahlen
1
2
3
4
5

tiere
hund
katze
maus

Also alle Datenblöcke sind in Spalte A und durch eine freie Zelle getrennt. Ich möchte nun, dass die einzelnen Blöcke eine eigene Spalte bekommen:

buchstaben	zahlen	tiere
a	1	hund
b	2	katze
c	3	maus
d	4
	5

Mit Transponieren klappt es leider nicht. Ich bin jetzt auf der Suche nach einem Makro, was das für beliebig viele Zeilen schafft. Ich habe es mit einer Makro-Aufzeichnung versucht, aber das klappt auch nur für das Beispiel.

Idee:
A1 markieren
2x Selection bis nach unten (geht ja mit STRG + unten, weil leere Zelle)
Dann markieren (STRG + Shift + unten)
Dann letzte Spalte mit Daten auswählen und einfügen
Und das alles wiederholen

Habt ihr eine Idee wie das in Code aussieht?

Danke und viele Grüße
Lukas

Sub CopyBlocks()
    With ActiveSheet
        Set cell = .Range("A1").End(xlDown).Offset(2, 0)  
        While cell.Value <> ""  
            cell.CurrentRegion.Copy .Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
            Set cell = cell.End(xlDown).Offset(2, 0)
        Wend
    End With
End Sub