VBA Destination Variable Copy issue

Question

My copy and paste code works fine when I test it IF there is already data in my destination. I need for it to work from scratch with no data for the department to begin inputing their own data. I notice that if I do not have data, it pastes over the top of my data range, or replaces data that is already there. I need it to start the first paste in cell E7 and then offset to the next row for each new set of data.

It seems to be breaking down at the Destination Variable(The whole code is posted below:

'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)

Entire Code

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

Harassed Dad · Accepted Answer · 2019-02-07 16:48:12Z

1

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

'start at the bottom and go up until you hit an occupied cell or the top of the spreadsheet

 If lstrow < 5 Then lstrow = 5

'if you hit a row less than 5 then set your pointer to 5

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

'in a blank sheet we are now at E6

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

'This won't move the top of dstrng from E6

" I need it to start the first paste in cell E7"
Can you spot the problem?

answered Feb 7, 2019 at 16:48

Harassed Dad

4,7141 gold badge12 silver badges12 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

Larry Spencer Over a year ago

Where I am telling it to start the 1strow

Scott Holtzman · Accepted Answer · 2019-02-07 17:00:49Z

0

This can be effective way to accomplish what you need:

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

answered Feb 7, 2019 at 17:00

Scott Holtzman

27.3k5 gold badges42 silver badges76 bronze badges

1 Comment

Siyon DP Over a year ago

Please marck as answared. so every SO user will see

Collectives™ on Stack Overflow

VBA Destination Variable Copy issue

2 Answers 2

1 Comment

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related