Hi Howard,

Am Sun, 13 Jul 2014 17:36:31 -0700 (PDT) schrieb L. Howard:

Many thanks, works very well. Just plug-and-play.

glad to help. Thank you for the feedback.

If you like to write the target columns with letters try:

Sub ABookToLong2()
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim arrCells() As Variant, arrCols As Variant
Dim myRng As Range, rngC As Range
Dim strCols As String
Dim i As Long

Set wksSource = ThisWorkbook.Sheets("Sheet1")
Set wksTarget = Workbooks("Copy of long.xlsm").Sheets("Sheet1")
Set myRng = wksSource.Range("A2,A4,R20,C10,N2,O4,F8,H12,G14")

strCols = "H,F,D,E,C,G,B,J,C"
arrCols = Split(strCols, ",")

For Each rngC In myRng
ReDim Preserve arrCells(myRng.Cells.Count - 1)
arrCells(i) = rngC
i = i + 1
Next

For i = LBound(arrCols) To UBound(arrCols)
wksTarget.Cells(Rows.Count, Asc(UCase(arrCols(i))) - 64) _
.End(xlUp)(2) = arrCells(i)
Next

End Sub


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