vba 将某些单元格复制到另一个工作表中的下一个空白行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21896367/
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 certain cells to the next blank row in another worksheet
提问by SaraDeeCee
I am fairly new to VBA and trying to do something that I feel is basic, but I keep getting stuck in the commands.
我对 VBA 相当陌生，并试图做一些我认为很基本的事情，但我一直被命令困住。
I have one worksheet "RA REQUEST FORM" that I am using as a form. Upon clicking a command button I would like certain cells (A22, D11, C18, C19) to be copied to the cells of the next empty row of an array on another worksheet "ACTIVE CREDITS", (COLUMNS A,B,E G) respectively. Can anyone help?
我有一个工作表“RA REQUEST FORM”，用作表格。单击命令按钮后，我希望将某些单元格（A22、D11、C18、C19）分别复制到另一个工作表“ACTIVE CREDITS”（COLUMNS A、B、EG）上数组的下一个空行的单元格. 任何人都可以帮忙吗？
采纳答案by Gary's Student
Perhaps something like:
也许是这样的：
Sub ButtonCode()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim DestRow As Long
Set ws1 = Sheets("RA REQUEST FORM")
Set ws2 = Sheets("ACTIVE CREDITS")
DestRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
ws1.Range("A22").Copy ws2.Range("A" & DestRow)
ws1.Range("D11").Copy ws2.Range("B" & DestRow)
ws1.Range("C18").Copy ws2.Range("E" & DestRow)
ws1.Range("C19").Copy ws2.Range("G" & DestRow)
End Sub
回答by Guy Nethery
Ugly but it works.
丑陋，但它的工作原理。
Sub Macro1()
'
' Macro1 Macro
'
'
Dim a22 As String
Dim d11 As String
Dim c18 As String
Dim c19 As String
Worksheets("RA REQUEST FORM").Activate
a22 = Range("A22").Value
d11 = Range("D11").Value
c18 = Range("C18").Value
c19 = Range("c19").Value
Worksheets("ACTIVE CREDITS").Activate
'select the first row with not value in column A skipping the first row e.g. - Offset(1)
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.Offset(0, 0).Value = a22
ActiveCell.Offset(0, 1).Value = d11
ActiveCell.Offset(0, 4).Value = c18
ActiveCell.Offset(0, 6).Value = c19
End Sub
回答by SaraDeeCee
Here is what I came up with after having issues with the text formatting messing up the look of the "active credits" worksheet. What do you think?
这是我在文本格式问题弄乱“活动学分”工作表的外观后想到的。你怎么认为？
Sub SENDTOLOG_Click()
Application.ScreenUpdating = False
Dim copysheet As Worksheet
Dim pastesheet As Worksheet
Set copysheet = Worksheets("RA REQUEST FORM")
Set pastesheet = Worksheets("ACTIVE CREDITS")
'Copy data from the RA REQUEST FORM to the active credits worksheet
'copy date
copysheet.Range("A22").Copy
pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'copy company name
copysheet.Range("D11").Copy
pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).PasteSpecial xlPasteValues
'copy credit amount
copysheet.Range("C19").Copy
pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(0, 4).PasteSpecial xlPasteValues
'copy invoice number
copysheet.Range("C18").Copy
pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(0, 6).PasteSpecial xlPasteValues
'insert basic status description into STATUS cell
pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(0, 3).Value = "WAITING FOR CREDIT CONFIRMATION"
'select payment method cell
pastsheet.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets("ACTIVE CREDITS").Activate
End Sub
