將某些單元格復制到另一個工作表中的下一個空白行

Question

我對VBA相當陌生，並嘗試做一些我認為很基本​​的事情，但是我一直陷於命令中。

我有一個工作表“ RA REQUEST FORM”，正在用作表單。 單擊命令按鈕后，我希望將某些單元格（A22，D11，C18，C19）分別復制到另一個工作表“ ACTIVE CREDITS”（列A，B，EG）上數組的下一個空行的單元格中。 有人可以幫忙嗎？

Answer 1

也許像這樣：

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

Answer 2

丑陋但行得通。

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

Answer 3

這是我在文本格式出現問題，弄亂了“主動積分”工作表的外觀后想到的。 你怎么看？

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