代码A，下面代码实现了：标红复制的数据，创建一个新的sheet，把数据放到新sheet里面。同时生成一个和当天excel同名的txt，把新sheet中的数据放到txt中。
Sub File_Loop_Example()
'Excel VBA code to loop through files in a folder with Excel VBA
Dim MyFolder As String, MyFile As String
'声明变量
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim lastRow As Long
Dim i As Long
Dim j As Long
Dim k As Long
'----save
Dim wb As Workbook
Dim fso As Object
Dim txtFile As Object
Dim filePath As String
Dim fileName As String
'Dim lastRow As Long
Dim lastCol As Long
Dim i_2 As Long
Dim j_2 As Long
'Opens a file dialog box for user to select a folder
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
MyFolder = .SelectedItems(1)
Err.Clear
End With
'Handle Errors
If Err.Number <> 0 Then
MyFolder = ""
End If
'Dir function returns the first file name that matches pathname
MyFile = Dir(MyFolder & "\", vbReadOnly)
'Do while there is still a file name in the MyFile variable
Do While MyFile <> ""
'Opens the file and assigns to the wbk variable for future use
Workbooks.Open fileName:=MyFolder & "\" & MyFile
'Do something with your workbook here
Sheets("EEPprogram_Temp").Activate
'设置工作表对象为当前激活的sheet
Set ws = ActiveSheet
'获取最后一行的行号
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
'创建一个新的sheet，命名为result，放在最后一个sheet之后
Set wsNew = Worksheets.Add(After:=Worksheets(Worksheets.Count))
wsNew.Name = "result"
'初始化新sheet中的行号为1
k = 1
'遍历每一行
For i = 1 To lastRow
'遍历每一列，从第一列到倒数第五列
For j = 1 To ws.Columns.Count - 4
'判断是否找到了5个连续的单元格，内容分别为SYNC，DEV_ADDR，REG_ADDR，DATA，CRC
If ws.Cells(i, j) = "SYNC" And _
ws.Cells(i, j + 1) = "DEV_ADDR" And _
ws.Cells(i, j + 2) = "REG_ADDR" And _
ws.Cells(i, j + 3) = "DATA" And _
ws.Cells(i, j + 4) = "CRC" Then
'如果找到了，则把这5个单元格的内容复制下来，并按顺序放到新sheet里面（假设从A列开始）
ws.Range(ws.Cells(i, j), ws.Cells(i, j + 4)).Interior.Color = RGB(255, 0, 0)
ws.Range(ws.Cells(i + 1, j), ws.Cells(i + 1, j + 4)).Copy Destination:=wsNew.Range("A" & k)
'更新新sheet中的行号为下一行（k+1）
k = k + 1
'退出内层循环，继续外层循环
Exit For
End If
Next j
Next i
'----------- save the result sheet and creat a txt
'设置工作簿对象为当前激活的工作簿
Set wb = ActiveWorkbook
'设置工作表对象为result sheet（假设已经存在）
Set ws = wb.Worksheets("result")
'获取最后一行和最后一列的编号（假设数据从A1开始）
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'创建FileSystemObject对象，用于操作文件和文件夹
Set fso = CreateObject("Scripting.FileSystemObject")
'获取当前工作簿所在的文件夹路径（不包含最后的反斜杠）
filePath = fso.GetParentFolderName(wb.FullName)
'获取当前工作簿的文件名（不包含扩展名）
fileName = fso.GetBaseName(wb.FullName)
'创建一个文本文件，路径和选择的文件夹相同，文本文件的名字和当前操作的excel文件名字相同（如果已经存在，则覆盖）
Set txtFile = fso.CreateTextFile(filePath & "\" & fileName & ".txt", True)
'遍历每一行数据（假设每个单元格都是16进制数据）
For i_2 = 1 To lastRow
'遍历每一列数据，用空格分隔，并写入文本文件中（不换行）
For j_2 = 1 To lastCol
txtFile.Write ws.Cells(i_2, j_2) & " "
Next j_2
'写入换行符，结束当前行数据的写入
txtFile.WriteLine
Next i_2
'关闭文本文件对象，并释放资源
txtFile.Close
Set fso = Nothing
'Close workbook without saving changes (change this if you want to save changes)
'Workbooks(MyFile).Close SaveChanges:=False
'Dir function returns the next file name that matches pathname
MyFile = Dir()
Loop
End Sub
