Excel宏可将数据从一个工作表复制并粘贴到另一工作表 [英] Excel macro to copy and paste data from one worksheet to another worksheet

问题描述

我正在尝试在列中搜索值并从Sheet1复制行并将新表创建为MySheet并粘贴该特定行.但是在将数据粘贴到MySheet中时遇到运行时错误.请提出任何建议.

I am trying to Search for a value in a column and copy row from Sheet1 and creating new sheet as MySheet and pasting that particular row .But I am getting run time error while pasting data in MySheet.Any suggestions please.

我正在尝试输入数据:

ID名称价格单位描述

ID name price units desc

1 ikura 10 4邮箱

1 ikura 10 4 Mail Box

2测试11 14 xxxx

2 test 11 14 xxxx

3测试11 14 yyyy

3 test 11 14 yyyy

4个测试11 14个邮箱

4 test 11 14 Mail Box

 Sub SearchForString()

        Dim LSearchRow As Integer
        Dim LCopyToRow As Integer

        On Error GoTo Err_Execute

        'Start search in row 4
        LSearchRow = 4

        'Start copying data to row 2 in Sheet2 (row counter variable)
        LCopyToRow = 2

    Worksheets.Add (After:=Worksheets(Worksheets.Count)).Name = "MySheet"
        While Len(Range("A" & CStr(LSearchRow)).Value) > 0

            'If value in column E = "Mail Box", copy entire row to Sheet2
            If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

                'Select row in Sheet1 to copy
                Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
                Selection.Copy

                'Paste row into Sheet2 in next row
                Sheets("MySheet").Select
                Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
                ActiveSheet.Paste

                'Move counter to next row
                LCopyToRow = LCopyToRow + 1

                'Go back to Sheet1 to continue searching
                Sheets("Sheet1").Select

            End If

            LSearchRow = LSearchRow + 1

        Wend

        'Position on cell A3
        Application.CutCopyMode = False
        Range("A3").Select

        MsgBox "All matching data has been copied."

        Exit Sub

    Err_Execute:
        MsgBox "An error occurred."

    End Sub

此致

Raju

推荐答案

尝试使用此简化版本:

Sub CopyData()

    '// Turn off screen updating for cosmetics
    Application.ScreenUpdating = False

    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MySheet"

    '// Change this to your sheet you are copying from
    With Sheet1
        '// Filter all rows with Mail Box
        .Range("E:E").AutoFilter Field:=1, Criteria1:="Mail Box", Operator:=xlAnd
        '// Copy all rows except header
        .UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Worksheets("MySheet").Cells(2, 1)
        '// Remove the autofilter
        If .AutoFilterMode Then .AutoFilterMode = False
     End With

    Application.ScreenUpdating = True

    MsgBox "All matching data has been copied."

End Sub

这篇关于Excel宏可将数据从一个工作表复制并粘贴到另一工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！