Новый, чтобы преуспеть и нуждается в некоторой помощи, чтобы скопировать данные на новый лист и продолжать работать

Question

Я новичок в VBA и не знаю, как мне нужно делать то, что я хочу.Я пытаюсь собрать определенные данные с одного листа (приемник отслеживания) на другой лист (данные), а затем очистить содержимое моего листа отслеживания приемника.Как сохранить данные и не перезаписать?Кроме того, иногда данные должны выходить за пределы получателя A: 16-D: 16, как лучше всего получать данные из A: 6-D: 6 и ниже?

Sub CopyPasteClear()
'
' CopyPasteClear Macro
'

'
    Range("A6:D16").Select
    Selection.Copy
    Sheets("data").Select
    Range("A:A").Select
    ActiveSheet.Paste
    Sheets("Recieve Tracker").Select
    Range("B6").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("D6").Select
    Selection.ClearContents
    Range("A8:D16").Select
    Selection.ClearContents
    Range("G12").Select
End Sub

****** РЕДАКТИРОВАТЬ Я попытался отредактировать код следующим образом, но все еще не получил результат. Я хочу Sub CopyPasteClear () '' CopyPasteClear Macro '

'
Range("A6:D1000").Select
Selection.Copy
Sheets("data").Select
lastrow = Sheets("data").Cells(Rows.Count, "A").End(xlUp).Row
Range("A:A").Select
ActiveSheet.Paste Destination:=Worksheets("data").Range("A" & lastrow)

Sheets("Recieve Tracker").Select
Range("B6").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D6").Select
Selection.ClearContents
Range("A8:D16").Select
Selection.ClearContents
Range("G12").Select
End Sub

Answer 1

Копировать Вставить Очистить

Ссылки

Загрузка рабочей книги (Dropbox)

Код

Sub CopyPasteClear()

    'Source
    Const cSource As String = "Recieve Tracker"   ' Worksheet Name
    Const cFirstRsrc As Long = 6                  ' First Row Number
    Const cClr As String = "B6,D6"                ' Clear Cells
    Const cRowClr As Long = 8                     ' First Clear Row
    Const cFinal As String = "G12"                ' Final Select Cell Address
    ' Target
    Const cTarget As String = "Data"              ' Worksheet Name
    ' Both
    Const cCol1 As Variant = "A"                  ' First Column Letter/Number
    Const cCol2 As Variant = "D"                  ' Second Column Letter/Number

    Dim vntVal As Variant   ' Value Array
    Dim LastRsrc As Long    ' Source Last Row Number
    Dim LastRtgt As Long    ' Target Last Row Number

    ' Source Range into Source Array
    With ThisWorkbook.Worksheets(cSource)
        ' Calculate Source Last Row Number of First Column.
        LastRsrc = .Columns(cCol1).Find("*", , -4123, , 2, 2).Row
        ' Prevent copying data above First Row. Rows from First Row to
        ' one less than First Clear Row will still be copied. To prevent this,
        ' change cFirstRsrc to cRowClr in the following line only.
        If LastRsrc < cFirstRsrc Then Exit Sub
        ' Copy Source Range into Source Array
        vntVal = .Range(.Cells(cFirstRsrc, cCol1), .Cells(LastRsrc, cCol2))
    End With

    ' Source Array into Target Range
    With ThisWorkbook.Worksheets(cTarget)
        ' Check if First Column in Target Worksheet does contain a value.
        If Not .Columns(cCol1).Find("*", .Cells(.Rows.Count, _
                .Columns.Count), -4123, , 2) Is Nothing Then ' Found.
            ' Calculate Target Last Row Number of First Column.
            LastRtgt = .Columns(cCol1).Find("*", , -4123, , 2, 2).Row
          Else  ' Not found.
            LastRtgt = 0 ' Because 1 will be added in the next line of the code.
        End If
        ' Copy Source Array into Target Range. Note that Target Last Row
        ' Number has to be inreased by 1 to get the first empty row.
        .Cells(LastRtgt + 1, cCol1) _
                .Resize(UBound(vntVal), UBound(vntVal, 2)) = vntVal
    End With

    With ThisWorkbook.Worksheets(cSource)
        ' Prevent deleting data above First Clear Row.
        If LastRsrc < cRowClr Then Exit Sub
        ' Clear contents of Clear Cells and modified Source Range.
        Union(.Range(cClr), .Range(.Cells(cRowClr, cCol1), _
                .Cells(LastRsrc, cCol2))).ClearContents
        ' Activate Source Worksheet if it is not active (not the ActiveSheet).
        ' The following Select method will produce an error if the program
        ' was started while a different worksheet than the Source Worksheet
        ' was active.
        If .Parent.ActiveSheet.Name <> .Name Then
            .Activate
        End If
        ' Select Final Select Cell.
        .Range(cFinal).Select
    End With

End Sub

Answer 2

Это обрежет данные из приемного трекера (A6: D6 и вниз) и вставит их в данные внизу (добавление данных внизу). Не зависит от данных в A1

Sub CopyPasteClear()
Dim cutRange As Range, pasteRange As Range
Dim shData As Worksheet
Dim shReceive As Worksheet

'You can adjust the names of the worksheets
'here, if needed
Set shData = Worksheets("Data")
Set shReceive = Worksheets("Receive Tracker")

'get the ranges we need to cut and paste
Set cutRange = shReceive.Range("A6:D" & shReceive.UsedRange.Rows.Count + 6)
Set pasteRange = shData.UsedRange.Cells(shData.UsedRange.Rows.Count, 1).Offset(1, 0).Resize(cutRange.Rows.Count, cutRange.Columns.Count)

'cut and paste
cutRange.Cut pasteRange
End Sub