Macro overwrites first row instead of pasting the data on the next row.

Copper Contributor

I'm trying to get this macro to paste data into the next row but all it does is overwrite the the first row. Can anyone help me please?

 

Sub ValidateExportData()
'
' ValidateExportData Macro
'
' Keyboard Shortcut: n/a
'
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim DataSource As Worksheet
Dim DataDestination As Worksheet
Dim LastRow As Long
Dim PasteRow As Long

On Error GoTo CleanUp

' Open the destination workbook
Dim TaskCalendar As Workbook
Set TaskCalendar = Workbooks.Open("S:\Task Management Calendar System\Task Calendar.xlsx")

' Set worksheets
Set DataSource = Workbooks("Analysis Request Form.xlsm").Worksheets("Analysis Request Form")
Set DataDestination = TaskCalendarWB.Worksheets("2025")

' Find the last row and move to the next row
LastRow = DataDestination.Range("D" & Rows.Count).End(xlUp).Row + 1

' Copy and paste values from the source to the destination
DataDestination.Cells(PasteRow, 4).Value = DataSource.Range("E11").Value ' Paste in column D
DataDestination.Cells(PasteRow, 5).Value = DataSource.Range("E12").Value ' Paste in column E

' Optional: Save and close the destination workbook
TaskCalendarWB.Close SaveChanges:=True

CleanUp:
Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True

If Err.Number <> 0 Then
MsgBox "An error occurred: " & Err.Description
End If

End Sub

3 Replies

@joshbernabe 

 

It seems that you are not setting PasteRow anywhere.  You need to calculate PasteRow before you use it in the lines where you set the values from E11 and E12.

 

You could use the following to set PasteRow to the next row in the list.  This command finds the last row in column D, then uses End.xlUp to search upward through all the empty cells to the one that has a value (similar to pressing Ctrl+Up on your keyboard). This is the last cell with a value in D.  Then add 1 to get to the next row.

PasteRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "D").End(xlUp).Row +1

 

I'm surprised you aren't getting an error on the steps where you use PasteRow.

 

Also, when you use End.xlUp, it means that it will find the top of the range. If you want to find the bottom of the range, you would use End.xlDown.  See here for more info - Range.End property.

@Steve_SumProductCom 

Thanks for your response. I have manage to fixed this issue by doing it like this:

DataSource.Range("E11").Copy
DataDestination.Range("D" & DataDestination.Range("D" & DataDestination.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues

DataSource.Range("E12").Copy
DataDestination.Range("E" & DataDestination.Range("E" & DataDestination.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues

 

I now have another issue, the data keeps getting pasted on row 893 and onwards instead of starting on row 2. Any idea what might be causing this?

 

This is my new code for more context:

Option Explicit

Sub ValidateExportData()
'
' ValidateExportData Macro
'
' Keyboard Shortcut: n/a
'
Dim RequestForm As Workbook
Dim TaskCalendar As Workbook
Dim DataSource As Worksheet
Dim DataDestination As Worksheet

Dim FindEmptyRow As Long

Set RequestForm = ThisWorkbook
Set TaskCalendar = Workbooks.Open("S:\RANDD\PILOT_PLANT\Evangeline\Josh\Task Management Calendar System\Task Calendar.xlsx")
Set DataSource = RequestForm.Worksheets("Analysis Request Form")
Set DataDestination = TaskCalendar.Worksheets("2025")

DataSource.Range("E11").Copy
DataDestination.Range("D" & DataDestination.Range("D" & DataDestination.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues

DataSource.Range("E12").Copy
DataDestination.Range("E" & DataDestination.Range("E" & DataDestination.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues

TaskCalendar.Save

End Sub

@joshbernabe I'm not sure why that's happening, but you can use your keyboard to simulate what Excel does with the End(xlUp) action, and that may help determine the cause.  Just select a cell in column D on that sheet, and press Ctrl+DownArrow until your selection goes all the way to the bottom of the sheet.  Then press Ctrl+UpArrow and see what cell it takes you to.

 

You can also add something like this to your macro temporarily to help debug it:

MsgBox DataDestination.Range("D" & DataDestination.Rows.Count).End(xlUp).Address