Probably Transpose function...
Option Explicit
Sub test()
Dim ws As Worksheet, a, b, i As Long, n As Long, flg As Boolean
For Each ws In Worksheets
If ws.Visible = -1 Then
With ws.Range("a1").CurrentRegion
a = .Rows(1).Value
.ClearContents
ReDim b(1 To Rows.Count): n = 0
With CreateObject("VBScript.RegExp")
.Pattern = "\b\d+\b"
Do
flg = False
For i = 1 To UBound(a, 2)
If .test(a(1, i)) Then
n = n + 1: flg = True
b(n) = .Execute(a(1, i))(0)
a(1, i) = .Replace(a(1, i), "")
End If
Next
Loop While flg
End With
With .Cells(1).Resize(n, 1)
.NumberFormat = "0"
.Value = b
.Columns.AutoFit
End With
End With
End If
Next
End Sub
Bookmarks