vba 复制并粘贴整行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/25271683/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copy and Paste Entire Row
提问by Landen
Function:I am working on a small project where I need to search each cell in a column for the word "Unknown" if it contains that word then copy that entire row on to a new sheet.
功能：我正在做一个小项目，我需要在列中的每个单元格中搜索“未知”这个词，如果它包含该词，然后将整行复制到新工作表上。
Problem:I am getting the "Object doesn't support this property method." error. I believe it is somewhere within the copy statement (not destination). It so simple but I cannot seem to solve this issue.
问题：我收到“对象不支持此属性方法”的消息。错误。我相信它在复制语句中的某个地方（不是目的地）。这很简单，但我似乎无法解决这个问题。
Sub CheckRows()
Dim b As Range
Dim SrchRng As Range
Set b = ActiveWorkbook.Sheets("Sheet 2").Range("A1")
Set SrchRng = ActiveWorkbook.Sheets("Sheet 1").Range("G1")
Do While SrchRng.Value <> ""
If SrchRng.Value = "Unknown" Then
Worksheets("Sheet 1").SrchRng.EntireRow.Copy _
Destination:=Worksheets("Sheet 2").b
Set b = b.Offset(1, 0)
Set SrchRng = SrchRng.Offset(1, 0)
Else: Set SrchRng = SrchRng.Offset(1, 0)
End If
Loop
End Sub
采纳答案by evenprime
Try Range.EntireRow.ValueProperty
尝试Range.EntireRow.Value属性
b.EntireRow.Value = SrchRng.EntireRow.Value
In
在
Do While SrchRng.Value <> ""
If SrchRng.Value = "Unknown" Then
b.EntireRow.Value = SrchRng.EntireRow.Value
Set b = b.Offset(1, 0)
Set SrchRng = SrchRng.Offset(1, 0)
Else: Set SrchRng = SrchRng.Offset(1, 0)
End If
Loop
回答by Dan Wagner
Consider the following situation:
考虑以下情况：
Sheet 1has a block of data, with "Unknown" entries in column G, and Sheet 2is empty.
Sheet 1有一个数据块，在 G 列中有“未知”条目，并且Sheet 2是空的。
By defining the block of data as a Rangeobject and applying an .Autofilterthat identifies the "Unknown" entries we can simply copy over the filtered results to Sheeet 2. The following heavily-commented script does just that:
通过将数据块定义为Range对象并应用.Autofilter标识“未知”条目的 ，我们可以简单地将过滤结果复制到Sheeet 2。以下被大量评论的脚本就是这样做的：
Option Explicit
Sub CheckRowsWithAutofilter()
Dim DataBlock As Range, Dest As Range
Dim LastRow As Long, LastCol As Long
Dim SheetOne As Worksheet, SheetTwo As Worksheet
'set references up-front
Set SheetOne = ThisWorkbook.Worksheets("Sheet 1")
Set SheetTwo = ThisWorkbook.Worksheets("Sheet 2")
Set Dest = SheetTwo.Cells(1, 1) '<~ this is where we'll put the filtered data
'identify the "data block" range, which is where
'the rectangle of information that we'll apply
'.autofilter to
With SheetOne
LastRow = .Range("G" & .Rows.Count).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set DataBlock = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With
'apply the autofilter to column G (i.e. column 7)
With DataBlock
.AutoFilter Field:=7, Criteria1:="=*Unknown*"
'copy the still-visible cells to sheet 2
.SpecialCells(xlCellTypeVisible).Copy Destination:=Dest
End With
'turn off the autofilter
With SheetOne
.AutoFilterMode = False
If .FilterMode = True Then .ShowAllData
End With
End Sub
Here is the output on Sheet 2:
这是输出Sheet 2：
