Combining multiple text files with same header format using excel VBA? - excel

Question

I have multiple text files I need to combine
All have the same headers (with the exception of the Image name, but this will change in ascending order, with "HU1284 - Position 2.Blind", "HU1284 - Position 3.Blind" etc), but varying numbers of rows of information within their dataset. I've been using an excel macro to combine them, but this requires separating each file in the program that generates the text files, and that takes ages. I'm trying to avoid that if possible. Would anyone be able to help me modify the VBA script below so that it can combine these text files as is? Thanks in advance!!
Public HeadLine As String
Public ThisLine As String
Public Checkfilenum
Public TotalRows
Public NDresults
Sub Comb_1()
' Comb_1 Macro Used to combine the text files together into a sindle result file if new data results
' in going over the row limit then attempt will be made to make a new dresult file by incrementing index.
' will loop through until a valid dresults file can be made.
nbook = ActiveWorkbook.Name
'checkfor opened dresults workbook
wcnt = 0
For Each w In Workbooks
If UCase(w.Name) Like "DRESULT*" Then
wcnt = 1
w.Activate
End If
Next
If wcnt = 1 And HeadLine = "FirstOne" Then HeadLine = ThisLine
' CHeck if adding new file will exceed 65536 limit of Excel (may need to change for 2007)
Call MaxNumRowscheck(nbook, wcnt)
' If dresults file is not opened then create it from thie file (nbook)
If wcnt = 0 Then
'Check if this is the first file in this run so we have line 6 to compare against.
If HeadLine = "FirstOne" Then HeadLine = ThisLine
On Error GoTo exitsub
' create dresults (note will check for existance of one just in case.)
ActiveWorkbook.SaveAs Filename:="dresults.xlsm", FileFormat:=xlNormal
Workbooks("dresults.xlsm").Activate
' prep sheet
Sheets(1).Name = "Combined data"
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)) _
, TrailingMinusNumbers:=True
Range("A3").Select
Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
:="_", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("A4").Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Range("G1:J1").Select
Selection.Cut
Range("A8").Select
ActiveSheet.Paste
Range("G3").Select
Selection.Cut
Range("E8").Select
ActiveSheet.Paste
Rows("1:6").Select
Selection.Delete Shift:=xlUp
Range("A2:E2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.FillDown
Selection.End(xlDown).Select
ActiveCell.Offset(0, 5).Range("A1").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, -1).Range("A1").Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveCell.FormulaR1C1 = "Exp_Round"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Within_Round_Pair"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Within_Pair_Imaged_Seq"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Image_Number"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Mask"
Range("A1").Select
ElseIf ThisLine = HeadLine Then
' repeat work above but for files just being prepared and appended
' using the previously started dresults file