Скопируйте определенные ячейки в следующую пустую строку на другом листе

Question

Я довольно новичок в VBA и пытаюсь сделать что-то, что, по моему мнению, является основным, но я продолжаю застревать в командах.

У меня есть один рабочий лист «ФОРМА ЗАПРОСА RA», который я использую в качестве формы. После нажатия на кнопку команды я хотел бы, чтобы некоторые ячейки (A22, D11, C18, C19) были скопированы в ячейки следующей пустой строки массива на другом листе «АКТИВНЫЕ КРЕДИТЫ» (COLUMNS 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