Splitting Rows into Multipule Files with Custom Naming.

[wearymicrobe]

I have a list of ~30,000 row's of data. The file name I want in Column B and the raw text data in A. I need to Split each individual rows into multiple Files to load them into a obscure piece of software that we use for data analysis.

Using the forum I have found this code from Dave Peterson which I have tested and used to breakup my data. Unfortunately it labels each file by increasing number. With as many data points as we have its getting difficult to say the least to cross reference by number.


DATA EXAMPLE

TGCCTGAGAGTTGCCCACGTCGGAGCCCCGGGCCAGGCT    21Pos_D_Reverse
CACTGCCTGAGAGTTGCCGTCCTCGGAGCCCCGGGCCAG    22Pos_D_Reverse
ACACACTGCCTGAGAGTTGTCCACCTCGGAGCCCCGGGC    23Pos_D_Reverse
AGGACACACTGCCTGAGAGTCGCCCACCTCGGAGCCCCG    24Pos_D_Reverse
CCCAGGACACACTGCCTGGTCGTTGCCCACCTCGGAGCC    25Pos_D_Reverse
AGTCCCAGGACACACTGCGTCAGAGTTGCCCACCTCGGA    26Pos_D_Reverse
CAGAGTCCCAGGACACACGTCCTGAGAGTTGCCCACCTC    27Pos_D_Reverse
ATTCAGAGTCCCAGGACAGTCTGCCTGAGAGTTGCCCAC    28Pos_D_Reverse
GCCATTCAGAGTCCCAGGGTCCACTGCCTGAGAGTTGCC    29Pos_D_Reverse 

WORKING CODE

Option Explicit
Sub testme()

Dim curWks As Worksheet
Dim newWks As Worksheet

Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

Set curWks = Worksheets("sheet1")
Set newWks = Workbooks.Add(1).Worksheets(1)

With curWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
.Rows(iRow).Copy
With newWks.Range("A1")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
newWks.Parent.SaveAs _
Filename:="C:\temp\" & Format(iRow, "0000") & ".csv", _
FileFormat:=xlCSV
Next iRow
End With

newWks.Parent.Close savechanges:=False

End Sub

So I have been playing with the above code to try and make a new file name based on the data in column B but to no avail. I can get it to reference A1 but not continue beyond that. not sure if excel can even use a "cell" to name a file at this point.

    Option Explicit
    Sub testme()

    Dim curWks As Worksheet
    Dim newWks As Worksheet

    Dim iRow As Long
    Dim FirstRow As Long
    Dim LastRow As Long

    Set curWks = Worksheets("sheet1")
    Set newWks = Workbooks.Add(1).Worksheets(1)

    With curWks
    FirstRow = 1
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    For iRow = FirstRow To LastRow
    .Rows(iRow).Copy
    With newWks.Range("A1")
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteFormats
    End With

 
    Dim MyPath As String, MyRange As Range
    MyPath = ThisWorkbook.Path
    Set MyRange = Sheets(1).Range("A1")
    ThisWorkbook.SaveAs Filename:=MyPath & "\" & MyRange.Value & ".xls" `Or CSV File
    

    Next iRow
    End With

    newWks.Parent.Close savechanges:=False

    End Sub

The changes are in bold. Is there some sort of naming convention command that I could use in the top code to reference the cell that I want, or am I on the right path. Any help or fixes to the code would be greatly appreciated. I am out of my element at this point.

Additionally I can put the file names on another sheet and link to that so that the file names do not end up in the data files.