我正在尝试在列中搜索值并从 Sheet1 复制行并将新工作表创建为 MySheet 并粘贴该特定行。但是在 MySheet 中粘贴数据时出现运行时错误。请提供任何建议。
我正在尝试的数据输入:
ID 名称 价格单位 desc
1 ikura 10 4 邮箱
2 测试 11 14 xxxx
3 测试 11 14 yyyy
4 测试 11 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
问候,
拉朱
最佳答案
第一件事:
恶魔的手段。直接处理范围/工作表对象。
错误描述。如果你从一开始就这样做了
可能不必发布这个问题。
以节省一些潜在的麻烦。
这是一些简化的代码,看看它是否有效:
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
关于Excel宏将数据从一个工作表复制并粘贴到另一个工作表,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/7505198/