如何从指定地址复制数据并使用excel vba将其复制到下一个指定位置

Question

我有一个工作表，其中包含每个产品的详细信息。

这里我有一个按钮（添加），通过点击它我想复制控制电源变压器块的所有细节并将其复制到下面（我的意思是从 B20 复制它）。

我已经编写了一个代码来确定 CTPT（这是该产品的唯一 ID），并将其作为参考我已经复制了整个块，直到使用下面的代码行结束。

Set cF = .Find(what:="CTPT", _
    lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

num = cF.Address ' Here we will the get the cell address of CTPT ($A$14)
            WsEPC.Range(cF.Offset(-1, 3), cF.Offset(-1, 1).End(xlDown)).Copy

现在在粘贴单元格时我需要做几件事

1. 我需要通过查找点击按钮的单元格地址来插入一行

2. 粘贴复制的数据

任何人的代码都可以帮助我完成这两项任务。 任何帮助表示赞赏！

Answer 1

Sub test_Karthik()
Dim WbEPC As Workbook, _
    WbCPT As Workbook, _
    WsEPC As Worksheet, _
    WsCPT As Worksheet, _
    FirstAddress As String, _
    WriteRow As Long, _
    cF As Range, _
    num As String

Set WbEPC = Workbooks("EPC 1.xlsx")
Set WbCPT = Workbooks("Control Power Transformers.xlsm")
Set WsEPC = WbEPC.Sheets("Sheet1")
Set WsCPT = WbCPT.Sheets("Sheet2")

With WsEPC
    .Activate
    With .Range("A1:A10000")
    'First, define properly the Find method
        Set cF = .Find(What:="CTPT", _
                    After:=ActiveCell, _
                    LookIn:=xlValues, _
                    Lookat:=xlPart, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False, _
                    SearchFormat:=False)

        'If there is a result, keep looking with FindNext method
        If Not cF Is Nothing Then
            FirstAddress = cF.Address
            Do
                num = cF.Address ' Here we will the get the cell address of CTPT ($A$14)
                WsEPC.Range(cF.Offset(0, 1).End(xlUp), cF.Offset(0, 3).End(xlDown)).Copy
                WriteRow = WsCPT.Range("E" & WsCPT.Rows.Count).End(xlUp).Row + 1
                WsCPT.Range("E" & WriteRow).PasteSpecial (xlPasteValues)

                cF.EntireRow.Insert xlDown, False


                Set cF = .FindNext(cF)
            'Look until you find again the first result
            Loop While Not cF Is Nothing And cF.Address <> FirstAddress
        End If
    End With
End With

End Sub

Answer 2

Private Sub CommandButton21_Click()




Dim WbEPC As Workbook, _
WbCPT As Workbook, _
WsEPC As Worksheet, _
WsCPT As Worksheet, _
FirstAddress As String, _
WriteRow As Long, _
cF As Range, _
num As String

Set WbEPC = Workbooks("EPC 1.xlsm")
Set WbCPT = Workbooks("Control Power Transformers.xlsm")
Set WsEPC = WbEPC.Sheets("Sheet1")
Set WsCPT = WbCPT.Sheets("Sheet1")

Dim b As Object, RowNumber As Integer
Set b = ActiveSheet.Shapes("CommandButton21")
With b.TopLeftCell
    RowNumber = .Row
End With


 Rows(RowNumber + 1 & ":" & RowNumber + 1).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove





    With WsEPC
    .Activate
    With .Range("A1:A10000")

Set cF = .Find(what:="CTPT", _
    lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

            num = cF.Address ' Here we will the get the cell address of CTPT ($A$14)
            WsEPC.Range(cF.Offset(-1, 3), cF.Offset(-1, 1).End(xlDown)).Copy
            WsEPC.Range("B" & RowNumber + 1).Select


                Selection.Insert Shift:=xlDown
                Application.CutCopyMode = False

End With
End With

MsgBox " Successfully added the product to EPC"


End Sub