在 VBA 中复制/粘贴多行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/28152378/
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/Paste multiple rows in VBA
提问by John
I am attempting to do a simple copy row, paste row within a workbook. I've searched threads and tried changing my code multiple times to no avail.
我正在尝试做一个简单的复制行，在工作簿中粘贴行。我搜索了线程并尝试多次更改我的代码无济于事。
The one that comes closest to working is this but it only copies a single instance of matching criteria.
最接近工作的是这个，但它只复制匹配条件的一个实例。
I am trying to create a loop that will copy all of the rows that has a match in one of the columns.
我正在尝试创建一个循环，该循环将复制其中一列中具有匹配项的所有行。
So, if 8 columns, each row with matching value in column 7 should copy to a named sheet.
因此，如果有 8 列，则第 7 列中具有匹配值的每一行都应复制到命名工作表中。
Sub test()
Set MR = Sheets("Main").Range("H1:H1000")
Dim WOLastRow As Long, Iter As Long
For Each cell In MR
If cell.Value = "X" Then
cell.EntireRow.Copy
Sheets("X").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
If cell.Value = "Y" Then
cell.EntireRow.Copy
Sheets("Y").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
If cell.Value = "Z" Then
cell.EntireRow.Copy
Sheets("Z").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
If cell.Value = "AB" Then
cell.EntireRow.Copy
Sheets("AB").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
Application.CutCopyMode = False
Next
End SubI like this because I need to target multiple destination sheets with different criteria but I need all rows that match criteria to copy over.
我喜欢这个，因为我需要使用不同的条件定位多个目标工作表，但我需要所有符合条件的行进行复制。
回答by user3561813
EDITED CODE IN RESPONSE TO NEW REQUEST:
响应新请求的编辑代码：
The code below will copy all of the rows in Sheet Mainand paste them into the corresponding worksheets based on the value in Column 7.
下面的代码将复制 Sheet 中的所有行，Main并根据第 7 列中的值将它们粘贴到相应的工作表中。
Do note: If there is a value in Column 7 that does NOT match to an existing sheet name, the code will throw an error. Modify the code to handle that exception.
请注意：如果第 7 列中的值与现有工作表名称不匹配，则代码将引发错误。修改代码以处理该异常。
Let me know of any additional needed help.
让我知道任何其他需要的帮助。
Sub CopyStuff()
Dim wsMain As Worksheet
Dim wsPaste As Worksheet
Dim rngCopy As Range
Dim nLastRow As Long
Dim nPasteRow As Long
Dim rngCell As Range
Dim ws As Worksheet
Const COLUMN_TO_LOOP As Integer = 7
Application.ScreenUpdating = False
Set wsMain = Worksheets("Main")
nLastRow = wsMain.Cells(Rows.Count, 1).End(xlUp).Row
Set rngCopy = wsMain.Range("A2:H" & nLastRow)
For Each ws In ActiveWorkbook.Worksheets
If UCase(ws.Name) = "MAIN" Then
'Do Nothing for now
Else
Intersect(ws.UsedRange, ws.Columns("A:H")).ClearContents
End If
Next ws
For Each rngCell In Intersect(rngCopy, Columns(COLUMN_TO_LOOP))
On Error Resume Next
Set wsPaste = Worksheets(rngCell.Value)
On Error GoTo 0
If wsPaste Is Nothing Then
MsgBox ("Sheet name: " & rngCell.Value & " does not exist")
Else
nPasteRow = wsPaste.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsMain.Range("A" & rngCell.Row).Resize(, 8).Copy wsPaste.Cells(nPasteRow, 1)
End If
Set wsPaste = Nothing
Next rngCell
Application.ScreenUpdating = True
End Sub
回答by Isaac Moses
Your current code is pasting to the same row in each sheet over and over, to the last row with a value in column A. Range("A" & Rows.Count).End(xlUp)says, roughly "go to the very bottom of the spreadsheet in column A, and then jump up from there to the next lowest cell in column A with contents," which gets you back to the same cell each time.
您当前的代码一遍又一遍地粘贴到每个工作表中的同一行，粘贴到 A 列中有值的最后一行。Range("A" & Rows.Count).End(xlUp)大致说“转到 A 列电子表格的最底部，然后从那里跳到A 列中包含内容的下一个最低单元格”，这使您每次都返回到同一个单元格。
Instead, you could use lines of the pattern:
相反，您可以使用模式行：
Sheets("X").Range("A" & Sheets("X").UsedRange.Rows.Count + 1).PasteSpecial
Where UsedRangeis a range containing all of the cells on the sheet with data in them. The + 1puts you on the following row.
哪里UsedRange是包含工作表上所有带有数据的单元格的范围。在+ 1以下行放你。
You could make this a little prettier using With:
您可以使用With以下方法使其更漂亮：
With Sheets("X")
.Range("A" & .UsedRange.Rows.Count + 1).PasteSpecial
End With
