Set wkb = rngSrc.Parent.Parent
wkb.SaveAs wkb.Path & "\FILE01", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
Workbooks.OpenText Filename:="C:\Users\Aikimark\Downloads\sample2.out", Origin:=437, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
Array(8, 1), Array(14, 1), Array(29, 1), Array(39, 1), Array(55, 1), Array(63, 1), Array( _
163, 1), Array(213, 1), Array(263, 1), Array(307, 1), Array(353, 1), Array(393, 1), Array( _
403, 1), Array(418, 1), Array(422, 1), Array(424, 1), Array(439, 1), Array(451, 1), Array( _
466, 1)), TrailingMinusNumbers:=True
Option Explicit
Public Sub ImportAndSplit()
Dim wkb As Workbook
Dim rngSrc As Range
Dim rngCell As Range
Dim rngTgt As Range
Dim rngUsed As Range
Dim strPath As String
Application.ScreenUpdating = False
'Open the file as fixed length data
Workbooks.OpenText Filename:="C:\Users\aikimark\Downloads\sample2.out", Origin:=437, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
Array(8, 1), Array(14, 1), Array(29, 1), Array(39, 1), Array(55, 1), Array(63, 1), _
Array(163, 1), Array(213, 1), Array(263, 1), Array(307, 1), Array(353, 1), Array(393, 1), _
Array(403, 1), Array(418, 1), Array(422, 1), Array(439, 1), Array(451, 1), _
Array(466, 1)), TrailingMinusNumbers:=True
strPath = ActiveWorkbook.Path
Set rngUsed = ActiveSheet.Range([A1], ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell))
'Trim column I
For Each rngCell In rngUsed.Columns(9).Cells
rngCell.Value = Left(rngCell.Value, Len(rngCell.Value) - 3)
Next
'Zero out the time component of the date/time value in column Q
For Each rngCell In rngUsed.Columns(17).Cells
rngCell.Value = Left(rngCell.Value, 6) & "000000"
Next
'Format P:R as numeric (no decimals)
rngUsed.Range("P:R").NumberFormat = "#0"
Set rngSrc = rngUsed.Columns(1)
Set wkb = Application.Workbooks.Add
Set rngTgt = wkb.Sheets(1).Range("A1")
For Each rngCell In rngSrc.Cells
If Len(rngCell.Value) = 0 Then
rngCell.EntireRow.Copy rngTgt
Set rngTgt = rngTgt.Offset(1)
End If
Next
Application.DisplayAlerts = False
wkb.SaveAs strPath & "\FILE02", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
wkb.Close False
For Each rngCell In rngSrc.Cells
If Len(rngCell.Value) = 0 Then
rngCell.EntireRow.Delete
End If
Next
Set wkb = ActiveWorkbook
wkb.SaveAs strPath & "\FILE01", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
wkb.Close False
Application.ScreenUpdating = True
End Sub
Option Explicit
Public Sub ImportAndSplit()
Dim wkb As Workbook
Dim rngSrc As Range
Dim rngCell As Range
Dim rngTgt As Range
Dim rngUsed As Range
Dim strPath As String
Application.ScreenUpdating = False
'Open the file as fixed length data
Workbooks.OpenText Filename:="C:\Users\aikimark\Downloads\sample2.out", Origin:=437, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
Array(8, 1), Array(14, 2), Array(29, 1), Array(39, 1), Array(55, 1), Array(63, 1), _
Array(163, 1), Array(213, 1), Array(263, 1), Array(307, 1), Array(353, 1), Array(393, 1), _
Array(403, 1), Array(418, 1), Array(422, 2), Array(439, 2), Array(451, 2), _
Array(466, 1)), TrailingMinusNumbers:=True
strPath = ActiveWorkbook.Path
Set rngUsed = ActiveSheet.Range([A1], ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell))
'Trim column I
For Each rngCell In rngUsed.Columns(9).Cells
rngCell.Value = Left(rngCell.Value, Len(rngCell.Value) - 3)
Next
'Zero out the time component of the date/time value in column Q
For Each rngCell In rngUsed.Columns(17).Cells
rngCell.Value = Left(rngCell.Value, 6) & "000000"
Next
Set rngSrc = rngUsed.Columns(1)
Set wkb = Application.Workbooks.Add
Set rngTgt = wkb.Sheets(1).Range("A1")
For Each rngCell In rngSrc.Cells
If Len(rngCell.Value) = 0 Then
rngCell.EntireRow.Copy rngTgt
Set rngTgt = rngTgt.Offset(1)
End If
Next
Set rngTgt = rngTgt.Offset(-1)
rngTgt.Worksheet.Range([A1], rngTgt).Value = Date
Application.DisplayAlerts = False
wkb.SaveAs strPath & "\FILE02", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
wkb.Close False
For Each rngCell In rngSrc.Cells
If Len(rngCell.Value) = 0 Then
rngCell.EntireRow.Delete
End If
Next
Set wkb = ActiveWorkbook
wkb.SaveAs strPath & "\FILE01", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
wkb.Close False
Application.ScreenUpdating = True
End Sub
Open in new window