VBA Destination Variable Copy проблема

Question

Мой код копирования и вставки работает нормально, когда я тестирую его, если в моем месте назначения уже есть данные.Мне нужно, чтобы все работало с нуля, и департамент не мог вводить свои собственные данные.Я замечаю, что если у меня нет данных, они вставляются поверх моего диапазона данных или заменяют данные, которые уже есть.Мне нужно, чтобы он начал первую вставку в ячейку E7, а затем смещение на следующую строку для каждого нового набора данных.

Кажется, что он разбивается на переменной назначения (весь код размещен ниже:

'переменная назначения

lstrow = Sheet3.Range("E" & Rows.Count).End(xlUp)
If lstrow < 5 Then lstrow = 5
Set DstRng = Sheet3.Range("E" & lstrow).Offset(1, 0)
Set DstRng = DstRng.Resize(SrcRng.Rows.Count, SrcRng.Columns.Count)

Весь код

Sub CopyCells()
'unprotect all sheets
'Unprotect_All
'dim variables
Dim DstRng As Range 'destination range
Dim SrcRng As Range 'source range
Dim Proceed As Boolean ' do we wish to proceed
Dim checkRng As Variant ' values to check
Dim i As Integer
Dim lstrow As Long

'These are mandatory fields and the error message
checkRng = Array( _
            Array("E3", "Please add the Agent Name"), _
            Array("H3", "The Evaluation Date is missing"), _
            Array("J3", "The Call Date is missing"), _
            Array("M3", "The Call ID is missing"), _
            Array("Q58", "Please score this evaluation before saving") _
            )
'Set proceed to true so this is the case unless it changes
Proceed = True

'source variable
Set SrcRng = Sheet1.Range("Eval_Data")

'destination variable
lstrow = Sheet3.Range("E" & Rows.Count).End(xlUp)
If lstrow < 5 Then lstrow = 5
Set DstRng = Sheet3.Range("E" & lstrow).Offset(1, 0)
Set DstRng = DstRng.Resize(SrcRng.Rows.Count, SrcRng.Columns.Count)

'mandatory fields
For i = 0 To 4
    If Len(Sheet1.Range(checkRng(i)(0))) = 0 Then
        Proceed = False
        MsgBox checkRng(i)(1)
        Sheet1.Range(checkRng(i)(0)).Activate
        Exit For
    End If
Next i

' if proceed is all good then go ahead
If Proceed = True Then
'give the user a chance to exit here
    If MsgBox _
        ("You are about to finalize this Evaluation." _
        & vbCrLf & "Please check everything before you proceed", _
        vbYesNo Or vbExclamation, "Are you sure?") = vbYes Then

        'copy and paste data without selecting
        DstRng.Value = SrcRng.Value

        'add Eval number
        With Sheet1.Range("H4")
            .Value = .Value + 1
        End With

        'confirmation message
        MsgBox "The Evaluation has been saved"

        'clear the invoice
        ClearEval
    End If
End If
'reprotect
'Protect_All
End Sub

Answer 1

Это может быть эффективным способом для достижения того, что вам нужно:

With sheet3
    lstrow = Application.WorksheetFunction.Max(7, .Range("E" & .Rows.Count).End(xlUp).Offset(1).Row)
    Set DstRng = .Range("E" & lstrow).Resize(SrcRng.Rows.Count, SrcRng.Columns.Count)
End With

Answer 2

 lstrow = Sheet3.Range("E" & Rows.Count).End(xlUp)

'начинайте снизу и поднимайтесь до тех пор, пока не достигнете занятой ячейки или верхней части таблицы

 If lstrow < 5 Then lstrow = 5

', если вы нажмете на строку меньше 5, установите указатель на 5

Set DstRng = Sheet3.Range("E" & lstrow).Offset(1, 0)

'на чистом листе мы сейчас на E6

Set DstRng = DstRng.Resize(SrcRng.Rows.Count, SrcRng.Columns.Count)

' Это не сдвинет верхнюю часть dstrng с E6

"Мне это нужнозапустить первую вставку в ячейку E7 "
Можете ли вы определить проблему?