Macro de excel para crear un script

Te anexo la macro.

Sub CrearScr()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("ABSCISA")
    Set l2 = Workbooks.Add
    Set h2 = l2.ActiveSheet
    '
    ruta = l1.Path & "\"
    For Each col In h1.Range("AD:AE").Columns
        u1 = h1.Cells(Rows.Count, col.Column).End(xlUp).Row
        u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
        h1.Range(h1.Cells(7, col.Column), h1.Cells(u1, col.Column)).Copy h2.Cells(u2, "A")
    Next
    l2.SaveAs Filename:=ruta & "doc.scr", FileFormat:=xlTextPrinter
    l2.Close False
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.