Question

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

这里我有一个按钮（ADD），通过点击它我想要复制CONTROL POWER TRANSFORMERS块的所有细节并将其复制到下面（我的意思是从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

现在，当粘贴细胞时，我需要做几件事

我需要通过查找点击按钮的单元格地址来插入行
粘贴复制的数据

任何一个代码都可以帮助我完成这些任务。感谢任何帮助！

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

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

2 个答案: