複製某些單元格到另一個工作表中的下一個空白行

Question

我對VBA相當陌生，試圖做一些我覺得很基礎的事情，但我一直陷在命令中。

我有一張工作表「RA請求表格」，我正在使用這種表格。在單擊命令按鈕時，我希望將某些單元格（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