Desde un libro existente crear nuevos libros con datos obtenidos

Aquí esta la macro... te estoy enviando también una copia por mail

Sub CrearArchivos()
'
' Macro7 Macro
Dim libromaestro As String
Dim ruta As String
Dim archivoagrabar As String
Dim nuevolibro As String
Dim colu As Integer
Dim i As Integer
Application.ScreenUpdating = False
libromaestro = ActiveWorkbook.Name
ruta = ActiveWorkbook.Path
colu = Application.WorksheetFunction.Count(Range("1:1"))
For i = 3 To colu + 2
Range("A1").Select
Workbooks.Add
nuevolibro = ActiveWorkbook.Name
Windows(libromaestro).Activate
Columns("A:B").Select
Selection.Copy
Windows(nuevolibro).Activate
ActiveSheet.Paste
Windows(libromaestro).Activate
Columns(i).Select
Application.CutCopyMode = False
Selection.Copy
Windows(nuevolibro).Activate
Range("C1").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
archivoagrabar = ruta & "\" & Range("C2").Value & "_" & Range("C1").Value
ActiveWorkbook.SaveAs Filename:=archivoagrabar, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Next i
Range("A1").Select
MsgBox ("Proceso finalizado" & vbNewLine & colu & " archivos creados")
Application.ScreenUpdating = True
End Sub