宏 - 查找工作,复制并粘贴行

宏 - 查找工作,复制并粘贴行

我想创建一个宏来查找工作(使用查找功能),然后复制该工作所在的行并复制并粘贴包括值和公式在内的整行。

每次要查找的工作编号都会有所不同,因此我希望弹出一个框供我填写,如果没有匹配项则会失败。

有人可以帮忙吗?

答案1

以下是一个 VBA 宏示例,可帮助您入门。代码中的注释用于描述意图。您可能希望添加错误处理以满足您的需求。

Sub CopyData()
    Dim res As String
    Dim cl As Range
    Dim sh As Worksheet

    ' operate on the active sheet
    Set sh = ActiveSheet

    ' ask for ID to find in column A
    res = InputBox("Enter ID to Find", "Copy Row")

    ' If no responce, exit
    If res = "" Then
        Exit Sub
    End If

    With sh
        ' Find first occurance
        Application.FindFormat.Clear
        Set cl = .Columns(1).Find(What:=res, _
            After:=.Cells(.Rows.Count, 1), _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=True)

        If Not cl Is Nothing Then
            ' if found, select entire row
            Set cl = cl.EntireRow
            ' copy and insert paste data into next row
            cl.Copy
            cl.Offset(1, 0).Insert
            ' turn off copy highlight (moving border)
            Application.CutCopyMode = False
        End If
    End With
End Sub

相关内容