Hi Howard,

Am Tue, 16 Jun 2015 02:01:24 -0700 (PDT) schrieb L. Howard:

I tried Garry's revised code and Claus' first code on 6000 rows. Returns 600 rows.

here is another suggestion.

Sub Transpose2()
Dim LRow As Long, i As Long, n As Long
Dim varOut() As Variant, varTmp As Variant

LRow = Cells(Rows.Count, 1).End(xlUp).Row
With Application
.ScreenUpdating = False
ReDim Preserve varOut(Int(LRow / 10))
For i = 11 To LRow Step 10
varTmp = .Transpose(Cells(i, 1).Resize(9, 1))
varOut(n) = Join(varTmp, ";")
n = n + 1
Next
Range("D2").Resize(n) = .Transpose(varOut)
End With
Columns("D:D").TextToColumns Destination:=Range("D2"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Semicolon:=True, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), _
Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True
Range("D2:L" & n).NumberFormat = "General"
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional