Excelmacros将数据从一个工作表复制并粘贴到另一个工作表

我试图search列中的值，从Sheet1复制行，并创build新的工作表MySheet和粘贴该特定的行。但是我粘贴MySheet.Anybuild议请运行时错误。

数据input我正在尝试：

ID名称价格单位desc

1 ikura 10 4邮箱

2testing11 14 xxxx

3testing11 14 yyyy

4testing11 14邮箱

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 

问候，

拉朱

Answer 1

试试这个简化版本：

 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 

Answer 2

首先要做的事情

• 停止使用。select和。激活时，他们是不需要的，他们是魔鬼的方法。 直接处理范围/工作表对象。
• 为了防万一，将你的行计数器从整数变成长整数。
• 明确地声明你正在使用哪个工作表可以避免奇怪的错误/错误。 如果您不喜欢打字，请使用工作表对象。
• 你的error handling程序应该总是输出err.Number和err.Description。 如果你从一开始就这样做了，那么你可能就不必发表这个问题了。
• Range.Copy有一个目标参数。 使用它而不是Range.Paste来节省一些潜在的麻烦。

这里有一些简化的代码，看它是否工作：

 Sub SearchForString() Dim LSearchRow As Long Dim LCopyToRow As Long Dim wksInput As Worksheet Dim wksOutput As Worksheet On Error GoTo Err_Execute 'Create a new sheet output to and store a reference to it 'in the wksOutput variable Set wksOutput = Worksheets.Add(AFter:=Worksheets(Worksheets.Count)) wksOutput.Name = "MySheet" 'The wksInput variable will hold a reference to the worksheet 'that needs to be searched Set wksInput = ThisWorkbook.Worksheets("Sheet2") 'Start copying data to row 2 in Sheet2 (row counter variable) LCopyToRow = 2 'Loop through all the rows that contain data in the worksheet 'Start search in row 4 For LSearchRow = 4 To wksInput.UsedRange.Rows.Count 'If value in column E = "Mail Box", copy entire row to wksOutput If wksInput.Cells(LSearchRow, 5) = "Mail Box" Then 'One line copy/paste wksInput.Rows(LSearchRow).Copy wksOutput.Cells(LCopyToRow, 1) 'Increment the output row LCopyToRow = LCopyToRow + 1 End If Next LSearchRow With wksInput .Activate .Range("A3").Select End With MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred. Number: " & Err.Number & " Description: " & Err.Description End Sub