Mira, marca la referencia "Microsoft Scripting Runtime" y pon este code
Código:
Dim FSO As New FileSystemObject
Dim TxS As TextStream, Fil As File
Dim a() As String, i As Integer, x As Integer
Set Fil = FSO.GetFile(App.Path & "\prueba.txt")
Set TxS = Fil.OpenAsTextStream(ForReading)
a() = Split(TxS.ReadAll, vbNewLine)
TxS.Close
x = 0
For i = LBound(a) To UBound(a)
If x > UBound(a) Then Exit For
Set TxS = FSO.CreateTextFile(App.Path & "\Prueba" & i & ".txt", True)
TxS.WriteLine a(x)
If x <> UBound(a) Then TxS.WriteLine a(x + 1)
x = x + 2
Next i
¿Qué es lo que hace?
1º Abre el archivo "prueba.txt" que contiene todos los nombres
2º Lo lee y lo guarda en un array a()
3º Recorre cada uno de los elementos del array, crea un nuevo archivo y escribe en él los elementos de dos en dos
Nota: Si el archivo a crear ya existe, lo sobreescribe.
La condición "
If x <> UBound(a) Then .." es por si en el archivo principal, las lineas fueran impares
Espero que se te pase el dolor de cabeza.