vba 在下一个空行中复制和粘贴设置范围
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17976329/
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 a set range in the next empty row
提问by Mike
This should be simple but I am having a tough time.. I want to copy the cells A3 through E3, and paste them into the next empty row on a different worksheet. I have used this code before in longer strings of code.. but i had to tweak it and it is not working this time. I get a "application-defined or object-defined error" when i run the code seen below. All help is appreciated.
这应该很简单，但我遇到了困难。我想复制单元格 A3 到 E3，然后将它们粘贴到不同工作表上的下一个空行中。我之前在更长的代码字符串中使用过这段代码..但我不得不调整它，这次它不起作用。当我运行下面看到的代码时，出现“应用程序定义或对象定义错误”。感谢所有帮助。
Private Sub CommandButton1_Click()
Dim lastrow As Long
lastrow = Range("A65536").End(xlUp).row
Range("A3:E3").Copy Destination:=Sheets("Summary Info").Range("A:A" & lastrow)
End Sub
回答by Joseph
Be careful with the "Range(...)" without first qualifying a Worksheet because it will use the currently Active worksheet to make the copy from. It's best to fully qualify both sheets. Please give this a shot (please change "Sheet1" with the copy worksheet):
在没有首先限定工作表的情况下使用“Range(...)”要小心，因为它将使用当前活动的工作表来制作副本。最好使两张表都完全合格。请试一试（请使用复制工作表更改“Sheet1”）：
EDIT: edited for pasting values only based on comments below.
编辑：仅根据下面的评论编辑粘贴值。
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet2")
copySheet.Range("A3:E3").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
回答by Andy G
The reason the code isn't working is because lastrow is measured from whatever sheet is currently active, and "A:A500" (or other number) is not a valid range reference.
代码不起作用的原因是因为 lastrow 是从当前活动的任何工作表中测量的，并且“A:A500”（或其他数字）不是有效的范围参考。
Private Sub CommandButton1_Click()
Dim lastrow As Long
lastrow = Sheets("Summary Info").Range("A65536").End(xlUp).Row ' or + 1
Range("A3:E3").Copy Destination:=Sheets("Summary Info").Range("A" & lastrow)
End Sub
回答by Charles
You could also try this
你也可以试试这个
Private Sub CommandButton1_Click()
Sheets("Sheet1").Range("A3:E3").Copy
Dim lastrow As Long
lastrow = Range("A65536").End(xlUp).Row
Sheets("Summary Info").Activate
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
回答by Zahid
Below is the code that works well but my values overlap in sheet "Final" everytime the condition of <=11meets in sheet "Calculator"
下面是运行良好的代码，但每次<=11在工作表“计算器”中满足条件时，我的值在工作表“最终”中重叠
I would like you to kindly support me to modify the code so that the cursor should move to next blank cell and values keeps on adding up like a list.
我希望您能支持我修改代码，以便光标移动到下一个空白单元格，并且值会像列表一样不断累加。
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Calculator")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Final")
For i = 2 To ws1.Range("A65536").End(xlUp).Row
If ws1.Cells(i, 4) <= 11 Then
ws2.Cells(i, 1).Value = Left(Worksheets("Calculator").Cells(i, 1).Value, Len(Worksheets("Calculator").Cells(i, 1).Value) - 0)
ws2.Cells(i, 2) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:D"), 4, False)
ws2.Cells(i, 3) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:E"), 5, False)
ws2.Cells(i, 4) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:B"), 2, False)
ws2.Cells(i, 5) = Application.VLookup(Cells(i, 1), Worksheets("Calculator").Columns("A:C"), 3, False)
End If
Next i
