Question

我正在尝试复制单元格的模板块，然后将其插入用户选择的行中。理想情况下，我希望代码复制模板块，然后下拉2行，插入块X次，其中X是用户需要的块数。 X将是输入框的结果。然后插入每个块后，打开替换文本窗口。如果有人可以通过输入框多次帮助我获取现有代码来插入模板块，这将是一个巨大的帮助。如果查找和替换工作完全可以更好

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

    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

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

0 个答案: