The first:
Click View > Macros > View Macros.
In the list under Macro name, click the macro you want to run.
Click Run.
Method 1
Sub SlpipFile()
Dim i As Long
Application.ScreenUpdating = False
ChangeFileOpenDirectory ActiveDocument.Path
Selection.Find.ClearFormatting
With Selection.Find
.Text = “^k”
.Forward = True
.Wrap = wdFindContinue
End With
ActiveDocument.Range(0, 0).Select
Do Until Selection.Find.Execute = False
i = i + 1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdParagraph, Count:=999999999, Extend:=wdExtend
Selection.Cut
Selection.TypeBackspace
ActiveDocument.SaveAs “File_” & VBA.Format(i, “000”) & “.doc”, 0
ActiveDocument.Close
Documents.Add DocumentType:=wdNewBlankDocument
Selection.Paste
ActiveDocument.Range(0, 0).Select
Loop
ActiveDocument.SaveAs “File_” & VBA.Format(i + 1, “000”) & “.doc”, 0
Application.ScreenUpdating = True
End Sub
Method 2:
Option Explicit
Sub SlpipFile3()
Dim i As Long
Dim tennv
Dim Fname
Application.ScreenUpdating = False
ChangeFileOpenDirectory ActiveDocument.Path
‘Selection.Find.ClearFormatting
With Selection.Find
.Text = “^k”
.Forward = True
.Wrap = wdFindContinue
End With
ActiveDocument.Range(0, 0).Select
Do Until Selection.Find.Execute = False
i = i + 1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdParagraph, Count:=999999999, Extend:=wdExtend
Selection.Cut
Selection.TypeBackspace
Selection.HomeKey Unit:=wdStory
Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=””
Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=””
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
tennv = Mid(Selection.Text, InStr(1, Selection.Text, “: “) + 1, Len(Selection.Text))
Fname = “File_” & tennv & “.docx”
ActiveDocument.SaveAs2 FileName:=Fname, FileFormat:=wdFormatXMLDocument, LockComments:=False, _
Password:=””, AddToRecentFiles:=True, WritePassword:=””, _
ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, CompatibilityMode:=14
Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdUseDestinationStylesRecovery)
ActiveDocument.Range(0, 0).Select
Loop
Application.Quit
Application.ScreenUpdating = True
End Sub
MEthod 3Option Explicit
Sub SplitFile()
Dim i As Long
Dim Stt As String
Dim Fname As String
Application.ScreenUpdating = False
ChangeFileOpenDirectory ActiveDocument.Path
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = “B?NG CHI TI?T TÍNH THU? TNCN NÃM”
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute
End With
Selection.MoveDown Unit:=wdLine, Count:=1
‘ActiveDocument.Range(0, 0).Select
Do Until Selection.Find.Execute = False
i = i + 1
‘ Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = “K? và ghi r? h? tên”
.Forward = True
.MatchWildcards = True
.Execute
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=2
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = “STT*: “
.Replacement.Text = “”
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Stt = Selection.Text
Selection.Find.ClearFormatting
With Selection.Find
.Text = “Tên nhân viên*: “
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Fname = “File_” & Stt & “_” & Selection.Text & “.docx”
ActiveDocument.SaveAs2 FileName:=Fname, FileFormat:=wdFormatXMLDocument, LockComments:=False, _
Password:=””, AddToRecentFiles:=True, WritePassword:=””, _
ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, CompatibilityMode:=14
Selection.WholeStory
Selection.Paste
Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = “B?NG CHI TI?T TÍNH THU? TNCN NÃM”
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute
End With
Loop
Selection.Find.ClearFormatting
With Selection.Find
.Text = “STT*: “
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Stt = Selection.Text
Selection.Find.ClearFormatting
With Selection.Find
.Text = “Tên nhân viên*: “
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Fname = “File_” & Stt & “_” & Selection.Text & “.docx”
ActiveDocument.SaveAs2 FileName:=Fname, FileFormat:=wdFormatXMLDocument, LockComments:=False, _
Password:=””, AddToRecentFiles:=True, WritePassword:=””, _
ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, CompatibilityMode:=14
MsgBox “done!” & Chr(13) & “There’s ” & i + 1 & ” page(s) were saved !”
Application.ScreenUpdating = True
End Sub
Test file:download here
comment for my helping