excel vba复制单元格块并插入多次

我试图复制一个模板块的单元格,然后让它插入到用户select的行。 理想情况下,我想要代码复制模板块,然后下拉2行,插入块X次,其中X是用户需要块的数量。 X将是input框的结果。 然后插入每个块后,打开replace文本窗口。 如果有人可以帮助我获得现有的代码,通过input框多次插入模板块,这将是一个巨大的帮助。 如果查找和replace工作将会更好

这是我的代码到目前为止。

Sub CopyTemplate() Worksheets("HR-Cal").Activate Dim rng As Range Dim trng As Range Dim tco As String 'Use the InputBox select row to insert copied cells Set rng = Application.InputBox("select row to paste into", Default:=ActiveCell.Address, Type:=8) startrow = rng.Row ' MsgBox "row =" & startrow Range("AF2") = startrow Application.ScreenUpdating = False 'copy template block Range("C6").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).FormulaR1C1 = "=ROW(RC[-1])" ActiveCell.Offset(1, 0).Cut Range("AF1").Activate ActiveSheet.Paste tco = "A5:AL" & Range("af1") Range(tco).Select Selection.Copy Range("A" & Range("af2")).Activate Selection.Insert Shift:=xlDown Application.ScreenUpdating = True 'find and replace text Dim Told As String Dim Tnew As String Dim rep As Range 'Use the InputBox to select text to be replaced Set rep = Application.InputBox("select data that needs text replaced", Default:=ActiveCell.Address, Type:=8) Told = Application.InputBox("Find the following text", Default:=ActiveCell.Address, Type:=1) Tnew = Application.InputBox("Input desired text", Default:=ActiveCell.Address, Type:=1) rep.Select Selection.Replace What:=Told, Replacement:=Tnew, LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False End Sub