我正在VBA中编写代码,该代码应收集文件.001类型,并将其转换为Excel文件(以空格分隔)。然后,我需要将其拆分为不同的文件(N个步骤),然后将其转换回.001文件(如原始文件)。但是我无法复制原始的.001格式。我可以附加原始文件吗?有没有其他方法可以将.001文件拆分为N个不同的.001文件?
Sub Import_file()
Dim MFC_name As String
Sheet1.Cells.ClearContents
Range("A1").Select
file_path = Application.GetOpenFilename()
Workbooks.OpenText filename:=file_path, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Columns("A:G").Select
Selection.Copy
Windows("code_test.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.ActivateNext
MFC_name = ActiveWorkbook.Name
Application.DisplayAlerts = False
ActiveWindow.Close
Range("I1").Value = MFC_name
Range("A1").Select
End Sub
Sub split_and_write()
Dim totalRows As Long
Dim newBook As Workbook
Dim curRow As Long
Dim filename As Variant
Dim lastRow As Long
Dim path As String
Dim myFileName As String
Dim r As Integer
totalRows = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For curRow = 8 To totalRows Step 1244
Set newBook = Workbooks.Add
With ThisWorkbook.Sheets("Sheet1")
'copy of the 7 rows with name+tool number+time and paste it to new workbook
ThisWorkbook.Worksheets("Sheet1").Range("A1:B7").Copy newBook.Sheets("Sheet1").Range("A1")
'copy and creation of the seperate workboks
.Rows(curRow & ":" & curRow + 1243).EntireRow.Copy newBook.Sheets("Sheet1").Range("A8")
'copy xcl to txt for each workbook
lastRow = newBook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'creation of .txt file path
path = "C:\XCL_FP\MFC_flow_cal\MFC_test\"
myFileName = InputBox("name?")
myFileName = myFileName & ".001" 'Providing extantion for the file
myFileName = path & myFileName
'writhing .xcl file to.001
Open myFileName For Output As #1
For r = 1 To lastRow
Print #1, Range("A" & r); " "; Range("B" & r)
Next r
Close #1
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
'filename = Application.GetSaveAsFilename
'newBook.saveas filename:=filename
End With
Next curRow
End Sub