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

Question

Скопируйте данные из Sheet3 и Sheet4, данные находятся в столбце A, и число ячеек будет меняться каждый раз.Я хочу скопировать данные из столбца a листа 3 и столбца a листа4 и вставить его в ячейку листа5 А3, а затем каждый раз в следующую пустую ячейку листа 5.это вставка данных только для листа 3, а не листа 4.

ниже приведен макрос, который я пробовал - введите описание изображения здесь Я пытался копировать макросы из различных потоков, но не смог этого сделать.Пожалуйста, помогите, поскольку я новичок в макросах.Заранее спасибо.

    Sub Macro10()
'
' Macro10 Macro
'

'
    Sheets("Sheet3").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet5").Select
    Range("A3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    Sheets("Sheet4").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet5").Select
    Worksheets(“Sheet5”).Activate
    erow = Sheet5.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets(“Sheet5”).Rows(erow)
    Range("A1").Select
    Application.CutCopyMode = False
End Sub

Answer 1

От рабочих листов до основной рабочей таблицы

Версия констант

Sub CopyToMaster()

    Const cSource1 As String = "Sheet3"  ' 1st Source Worksheet Name
    Const cSource2 As String = "Sheet4"  ' 2st Source Worksheet Name
    Const cTarget As String = "Sheet5"   ' Target Worksheet
    Const cRange As String = "A3"        ' First Cell Address of Copy Range
    Const cCol As Long = 1               ' Target Column Number

    Dim ws1 As Worksheet  ' 1st Source Worksheet
    Dim ws2 As Worksheet  ' 2nd Source Worksheet
    Dim wsT As Worksheet  ' Target Worksheet

    Dim Rng As Range      ' Copy Range (in 1st and 2nd Source Worksheet)
    Dim FNR As Long       ' First Not Used Row

    ' Create references to all Worksheets
    With ThisWorkbook
        Set ws1 = .Worksheets(cSource1)
        Set ws2 = .Worksheets(cSource2)
        Set wsT = .Worksheets(cTarget)
    End With

    ' Calculate First Not Used Row in Target Column.
    FNR = wsT.Cells(wsT.Rows.Count, cCol).End(xlUp).Offset(1).Row
    ' Calculate Copy Range in 1st Source Worksheet
    Set Rng = ws1.Range(ws1.Range(cRange), ws1.Range(cRange).End(xlDown))
    ' Copy Copy Range in 1st Source Worksheet to Target Column.
    Rng.Copy wsT.Cells(FNR, cCol)
    ' Calculate First Not Used Row in Target Column.
    FNR = wsT.Cells(wsT.Rows.Count, cCol).End(xlUp).Offset(1).Row
    ' Calculate Copy Range in 2nd Source Worksheet
    Set Rng = ws2.Range(ws2.Range(cRange), ws2.Range(cRange).End(xlDown))
    ' Copy Copy Range in 2nd Source Worksheet to Target Column.
    Rng.Copy wsT.Cells(FNR, cCol)

End Sub

Версия 'I Hate Constants'

Sub IHateConstants()

    Dim ws1 As Worksheet  ' 1st Source Worksheet
    Dim ws2 As Worksheet  ' 2nd Source Worksheet
    Dim wsT As Worksheet  ' Target Worksheet

    Dim Rng As Range      ' Copy Range (in 1st and 2nd Source Worksheet)
    Dim FNR As Long       ' First Not Used Row

    ' Create references to all Worksheets
    With ThisWorkbook
        Set ws1 = .Worksheets("Sheet3")
        Set ws2 = .Worksheets("Sheet4")
        Set wsT = .Worksheets("Sheet5")
    End With

    ' Calculate First Not Used Row in first column of Target Worksheet.
    FNR = wsT.Cells(wsT.Rows.Count, 1).End(xlUp).Offset(1).Row
    ' Calculate Copy Range in 1st Source Worksheet
    Set Rng = ws1.Range(ws1.Range("A3"), ws1.Range("A3").End(xlDown))
    ' Copy Copy Range in 1st Source Worksheet to first column of Target
    ' Worksheet.
    Rng.Copy wsT.Cells(FNR, 1)
    ' Calculate First Not Used Row in first column of Target Worksheet.
    FNR = wsT.Cells(wsT.Rows.Count, 1).End(xlUp).Offset(1).Row
    ' Calculate Copy Range in 2nd Source Worksheet
    Set Rng = ws2.Range(ws2.Range("A3"), ws2.Range("A3").End(xlDown))
    ' Copy Copy Range in 2nd Source Worksheet to first column of Target
    ' Worksheet.
    Rng.Copy wsT.Cells(FNR, 1)

End Sub