Sub splfile()
Dim i As Long, j As Long, k As Long, n As Long, m As Long
Dim wb As Worksheet, rng As Range, darr, arr
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = ThisWorkbook.Worksheets("sheet1")
Set rng = wb.Range([a3], [G100000].End(xlUp)): arr = rng
ReDim darr(1 To 99, 1 To UBound(arr, 2))
On Error Resume Next
n = Int(UBound(arr) / 99) + 1
retu:
Set pfolder = CreateObject("shell.application").browseforfolder(0, "Chon folder", 0, 0)
If Not TypeName(pfolder) = "Nothing" Then
Path = pfolder.self.Path
Else
MsgBox " Chua chon folder luu file"
GoTo retu
End If
For k = 1 To n
ReDim darr(1 To 99, 1 To UBound(arr, 2)): m = 0
For i = (k - 1) * 99 + 1 To k * 99
m = m + 1
For j = 1 To UBound(arr, 2)
darr(m, j) = arr(i, j)
Next j
Next i
With Workbooks.Add
wb.[a1:g2].Copy .Worksheets("sheet1").[a1]
.Worksheets("sheet1").[a3].Resize(UBound(darr), UBound(darr, 2)) = darr
rng.Copy: .Worksheets("sheet1").[a3].PasteSpecial xlFormats
.SaveAs Path & "\File_" & k
.Close True
End With
Next k
Set pfolder = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.CutCopyMode = False
Call Shell("explorer.exe " & Path, vbNormalFocus)
End Sub
