VBA隔行插入代码

Question

表格1中行数不固定，我想从表格2中复制第25、26行，填入表格1第25、26行，填入表格1以后，在表格1中每隔20行添加一次从表格2中复制的第25、26行，直至表格1中的不是空白的行数填满为止。

我编了VBA代码如下：
Sheets("表格二").Select Rows("25:26").Select Application.CutCopyMode = False Selection.Copy Sheets("表格一").Select Rows("25:26").Select ActiveSheet.Paste j = Application.InputBox("请输入跳行数：", "温馨提示", , , , , , 1)
For k = 1 To j Selection.Copy Selection.Insert Shift:=xlDown Next k
但是生成的表格是连续的。

这是执行VBA后的截图

原本想达到是这样的目的

请老师指点迷津，帮我改写一下代码。谢谢。祝中秋快乐。
这个是表格一的表头

循环插入至单元格末尾。

Answer 1

Sub LKJ()
    j = Application.InputBox("请输入跳行数：", "温馨提示", , , , , , 1)
    j = j + 1
    Set S1 = Sheets("表格一")
    Set S2 = Sheets("表格二")
    S1.Rows(j & ":" & j + 1).Insert
    S2.Rows("25:26").Copy S1.Rows(j)
    xr = S1.[A65536].End(3).Row
    For k = j To xr Step j
        x = x + 1
        S1.Rows(j & ":" & j + 1).Copy
        S1.Rows(j * (x + 1) + x).Insert Shift:=xlDown
    Next k
    Application.CutCopyMode = False
End Sub

Answer 2

修改了一下代码，试过了，可以用

Sub www()
Dim A As Range
Dim r As Integer
Sheets("表格二").Select
Set A = Rows("25:26")
Application.CutCopyMode = False
A.Copy
Sheets("表格一").Select
Rows("25:26").Select
ActiveSheet.Paste

j = Application.InputBox("请输入跳行数：", "温馨提示", , , , , , 1)
r = 25
For k = 1 To j

r = r + 20
Rows(r).Select
A.Copy
Selection.Insert Shift:=xlDown
Next k
End Sub本回答被网友采纳

Answer 3

你这个可以VBA来实现，但是这样做不好，不利于你后期的数据插入、删除、排序，正确的方法是设置页眉、页脚，让打印的时候显示页面的头尾，但是输入的时候只有数据，这才是正确的出路。