Sub split()
Application.ScreenUpdating = False
Dim wkbSource As Excel.Workbook
Dim wkbImport As Excel.Workbook
Dim wksImport As Excel.Worksheet
Dim rngResult As Excel.Range
Dim strFirstAddr As String
Dim strPath As String
Dim strFilename As String
Dim lngRowId As Long
Dim r As Range
Dim limit As Long
Dim loops As Integer
strPath = "K:\ALC\User\msu\RBPL_TimeSeries\"
For i = 5 To 8
Set wkbSource = Workbooks.Open(strPath & i & ".xlsx")
With wkbSource.Sheets(1)
Set r = .[A1]
limit = .Cells(.Rows.Count, r.Column).End(xlUp).Row
loops = (limit \ 30000) + 1
End With
For j = 1 To loops
With wkbSource.Sheets(1)
Set r = .Range(.Cells((j - 1) * 30000 + 1, 1), .Cells((j * 30000), 1))
r.TextToColumns Destination:=r, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(39, 3), Array(40, 2), Array(38, 2)), TrailingMinusNumbers:=True
End With
Next j
Range(Columns(1), Columns(19)).Delete
Range(Columns(2), Columns(11)).Delete
Range(Columns(3), Columns(9)).Delete
Range(Columns(4), Columns(11)).Delete
Range(Columns(5), Columns(189)).Delete
Range(Columns(8), Columns(117)).Delete
Range(Columns(9), Columns(11)).Delete
Range(Columns(10), Columns(45)).Delete
Range(Columns(11), Columns(11)).Delete
wkbSource.Close (True)
Next i
End Sub