A=1~40
C=41~80
E=81~120

A=121~160
C=161~200
E=201~240
....到最後

[attach]35752[/attach]

Sub TEST_A1()
Dim xA As Range, xR As Range
Intersect(ActiveSheet.UsedRange, Range("a:f")).Offset(2, 0).Clear
Application.ScreenUpdating = False
Set xA = [a3]:  Set xR = [k2]
Do While xR <> ""
xR.Resize(40, 2).Copy xA
Set xR = xR(41): Set xA = xA(1, 3)
If xA.Column = 7 Then Set xA = xA(41, -5)
Loop
End Sub

謝謝前輩發表此主題與範例

Option Explicit
Sub TEST_A1()
Dim xA As Range, xR As Range
'↑宣告變數:(xA,xR)是儲存格變數
Intersect(ActiveSheet.UsedRange, Range("a:f")).Offset(2, 0).Clear
'↑令交集的範圍儲存格 往下偏移2列範圍 清除
'交集的範圍儲存格: 操作表已使用的儲存格範圍 與[A:F]欄儲存格重疊的儲存格
,https://learn.microsoft.com/zh-tw/office/vba/api/excel.application.intersect
Application.ScreenUpdating = False
'↑令螢幕畫面暫不隨程序做變化
Set xA = [a3]:  Set xR = [k2]
'↑令xA這儲存格變數是 儲存格[A3] :令xR這儲存格變數是 儲存格[K2]
Do While xR <> ""
'↑設條件迴圈(當xR變數值不是空字元!就繼續執行)
'https://learn.microsoft.com/zh-tw/dotnet/visual-basic/language-reference/statements/do-loop-statement
xR.Resize(40, 2).Copy xA
'↑令xR變數擴展向下40列,向右擴展2欄的範圍儲存格複製到 xA變數
Set xR = xR(41): Set xA = xA(1, 3)
'↑令xR變數換成是 自身(含)往下41列位置儲存格
'令xA變數換成是 自身(含)往右3欄位置儲存格
'xR(41) = xR(41,1) = xR.Item(41, 1)

If xA.Column = 7 Then Set xA = xA(41, -5)
'↑如果xA變數的欄號是7 (G欄)!
'就令xA變數換成是 自身(含)往下41列/往左7欄位置儲存格
'自身(含)是1,往左7欄:(-5,-4,-3,-2,-1,0,1)
'(A,B,C,D,E,F,G)

Loop
End Sub

以下是後學練習留空白在下方的方法,請前輩參考

[attach]35754[/attach]

Option Explicit
Sub TEST_A2()
Dim xA As Range, xR As Range, R%
Intersect(ActiveSheet.UsedRange, Range("a:f")).Offset(2, 0).Clear
ActiveSheet.ResetAllPageBreaks
Application.ScreenUpdating = False
R = 40:  Set xA = [a3]:  Set xR = [k2]
Do While xR <> ""
If xA.Column = 7 Then
Set xA = xA(R + 1, -5)
xA.PageBreak = xlPageBreakManual
If xR(R * 3) = "" Then
R = (Cells(Rows.Count, "K").End(3).Row - 1) Mod R * 3
R = IIf(R Mod 3, R \ 3 + 1, R \ 3)