Combining Columns For Printing

Maybe:

Sub Adrian(): Dim wa As Worksheet, ws As Worksheet, r As Long, s As Long, PI As String, i As Long
Set wa = ActiveSheet:           For Each ws In Worksheets
                        If ws.name = "Summary" Then GoTo SetSummary
                                Next
            Worksheets.Add(Before:=Worksheets(1)).name = "Summary"
SetSummary: Set ws = Sheets("Summary"): ws.Columns(1).ColumnWidth = 48: s = 2
            ws.Columns(1).HorizontalAlignment = xlCenter
        For r = 2 To wa.Range("A" & Rows.Count).End(xlUp).row
            For i = 1 To Len(wa.Cells(r, 12))
    If IsNumeric(Mid(wa.Cells(r, 12), i, 1)) Then PI = PI & Mid(wa.Cells(r, 12), i, 1)
            Next i: PI = Left(PI, 3) & "-" & Mid(PI, 4, 3) & "-" & Right(PI, 4)
                PI = wa.Cells(r, 3) & Chr(10) & _
wa.Cells(r, 4) & " , " & wa.Cells(r, 5) & " " & wa.Cells(r, 6) & " " & _
                wa.Cells(r, 7) & Chr(10) & PI
                ws.Cells(s, 1) = PI: PI = "": s = s + 1
Next r
End Sub