Option Explicit
Dim FRow As Long
Dim rngData As Range, PhName As String
Dim soPh As Long, iP As Long, endR As Long, SoTS As Long, SoDu As Long
Dim SoTSph As Long
Sub ChiaPhongThi()
FRow = 5
SoTSph = 24
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual
.DisplayAlerts = False
End With
Sheets("ChiaPhongThi").Select
xoash
With Sheets("ChiaPhongThi")
endR = .Cells(65000, 2).End(xlUp).Row 'cot ten hs'
SoTS = endR - 1
End With
soPh = Int(SoTS / SoTSph)
If SoTS Mod SoTSph < 4 Then
soPh = soPh
If SoTS Mod SoTSph > 0 Then
SoDu = SoTS Mod SoTSph
End If
Else
soPh = soPh + 1
End If
Set rngData = Range("A2:K" & endR)
For iP = 1 To soPh
If iP Mod 20 = 0 Then ActiveWorkbook.Save
If SoDu <> 0 Then
PhName = "Ph" & Right("00" & iP, 3)
Sheets("Mau").Copy after:=Sheets("Mau")
With ActiveSheet
.Name = PhName
If iP < soPh Then
.Range("B" & FRow & ":F" & FRow + SoTSph - 1).Value = rngData.Offset(SoTSph * (iP - 1), 1).Resize(SoTSph, 5).Value
.Range("G" & FRow & ":G" & FRow + SoTSph - 1).Value = rngData.Offset(SoTSph * (iP - 1), 10).Resize(SoTSph, 1).Value
Else
.Range("B" & FRow & ":F" & FRow + SoTSph - 1 + SoDu).Value = rngData.Offset(SoTSph * (iP - 1), 1).Resize(SoTSph + SoDu, 5).Value
.Range("G" & FRow & ":G" & FRow + SoTSph - 1 + SoDu).Value = rngData.Offset(SoTSph * (iP - 1), 10).Resize(SoTSph + SoDu, 1).Value
'tao so tt lai
With .Range("A" & FRow & ":A28")
.ClearContents
End With
With .Range("A" & FRow & ":A" & FRow + SoTSph + SoDu - 1)
.FormulaR1C1 = "=ROW()-4"
.Value = .Value
End With
End If
End With
End If
Next
Set rngData = Nothing
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
.DisplayAlerts = True
End With
End Sub
Sub xoash()
Dim Sh As Worksheet
For Each Sh In Worksheets
If Left(Sh.Name, 2) = "Ph" Then Sh.Delete
Next
End Sub
