Public Sub NAddr3SS()
'Convert 1-Up Name and Address labels to Spread Sheet format.
'David McRitchie  http://www.mvps.org/dmcritchie/excel/excel.htm
'   1999-03-01  http://www.mvps.org/dmcritchie/excel/naddr2ss.txt
'   2001-04-10  http://www.mvps.org/dmcritchie/excel/code/naddr3ss.txt
'  description: http://www.mvps.org/dmcritchie/excel/snakecols.htm
'               modified for max of default 3 lines per input label
Dim nCol As Long, nRow As Long
Dim cRow As Long
Dim lastrow As Long
Dim wsSource As Worksheet
Dim wsNew As Worksheet
Dim linesPerSet As Variant  'Number of rows per label on input
linesPerSet = 3
Dim ans As String
ans = InputBox("A new Sheet will be created converting " _
  & "Single column in ""A"" to multiple columns " _
  & Chr(10) & Chr(10) _
  & "Specify Number Rows per input label set, " _
  & "use 0 if blank row separates sets", _
  "Specify Rows per set", linesPerSet)
If ans = "" Then
   MsgBox "Cancelled by your command"
   Exit Sub
End If
linesPerSet = CVar(ans)
nCol = 0
nRow = 1
lastrow = Cells.SpecialCells(xlLastCell).Row
Set wsSource = ActiveSheet
Set wsNew = Worksheets.Add
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'xl95 uses xlManual

Application.DisplayAlerts = False
For cRow = 1 To lastrow
   If linesPerSet = 0 Then
      If Trim(wsSource.Cells(cRow, 1).Value) = "" Then
         If nCol > 0 Then nRow = nRow + 1
         nCol = 0
      Else
         nCol = nCol + 1
         wsNew.Cells(nRow, nCol).Value = wsSource.Cells(cRow, 1).Value
      End If
   Else
      If linesPerSet = nCol Then
         nRow = nRow + 1
         nCol = 1
      Else
         nCol = nCol + 1
      End If
      wsNew.Cells(nRow, nCol).Value = wsSource.Cells(cRow, 1).Value
   End If
Next cRow
Application.DisplayAlerts = True

Application.Calculation = xlCalculationAutomatic 'xl95 uses xlAutomatic
Application.ScreenUpdating = True
End Sub