Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Automatically Copy New Data to Another Worksheet

0

I'm following this code but need the new data to be imported at the beginning after the header row. 

Sub Copy_New_Data()
''''''''  TeachExcel.com  ''''''''
'Copy all new rows from one worksheet to another.

Dim importSheet, destinationSheet As Worksheet
Dim importLastRow, importColumnCheck, destinationColumnCheck, _
importStartRow, destinationStartRow, curRow, destinationLastRow As Integer
Dim dataToCheck As Variant
Dim rng, rDel As Range


' ------------------------------------------------------------------- '
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| '
'           Change this section to work for your workbook.
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| '
' ------------------------------------------------------------------- '
'Set the worksheets
Set importSheet = Sheets("Import") 'worksheet to copy data from
Set destinationSheet = Sheets("backup") 'worksheet to paste new data

'Import data column to check
importColumnCheck = 1
'Destination data column to check
destinationColumnCheck = 1

'Start row on import sheet
importStartRow = 2
'Start row on destination sheet
destinationStartRow = 2
' ------------------------------------------------------------------- '
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| '
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| '
' ------------------------------------------------------------------- '


'Get last row from import worksheet
importLastRow = importSheet.Cells(Rows.Count, importColumnCheck).End(xlUp).Row

'Loop through range
For curRow = importStartRow To importLastRow

    'Get data to check
    dataToCheck = importSheet.Cells(curRow, importColumnCheck).Value

    'Get last row from destination sheet
    destinationLastRow = destinationSheet.Cells(Rows.Count, importColumnCheck).End(xlUp).Row

    'Check for duplicate
    With destinationSheet.Range(destinationSheet.Cells(destinationStartRow, destinationColumnCheck), destinationSheet.Cells(destinationLastRow, destinationColumnCheck))
        Set rng = .Find(What:=dataToCheck, _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

        If Not rng Is Nothing Then
            'Record already exists

            'mark rows for deletion
            If Not rDel Is Nothing Then
                Set rDel = Union(Range("A" & curRow), rDel)
            Else
                Set rDel = Range("A" & curRow)
            End If

        Else
            'New record, so copy it over
            importSheet.Range("A" & curRow).EntireRow.Copy destinationSheet.Range("A" & destinationLastRow + 1)

            'mark rows for deletion
            If Not rDel Is Nothing Then
                Set rDel = Union(Range("A" & curRow), rDel)
            Else
                Set rDel = Range("A" & curRow)
            End If

        End If

    End With

Next curRow

'Delete rows that need to be deleted
'Un-comment the next line of code if you want to delete copied rows.
'rDel.EntireRow.Delete

End Sub

Thank you
Answer
Discuss

Answers

0

Hi RWSM and welcome to the Forum.

Firstly, for the future, it nearly always helps us to provide an answer if you upload a representative Excel file with your question (using the Add Files... button) since it saves us time. This should be without any personal data but include your existing macro and sample data. 

I don't recognise that macro (or which of Don's tutorials it came from) but to copy the data at the start of the backup sheet (rather than the end, only two lines need to change (but I added comments below), see changes in bold below:

Else

        'New record, so

            'Insert row at top to insert new data

            destinationSheet.Rows(destinationStartRow).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow

            ' copy it over

            importSheet.Range("A" & curRow).EntireRow.Copy destinationSheet.Range("A" & destinationStartRow)

The first code line inserts a new row (at the start row which is defined earlier in the macro) and copies any formatting from the row below (not any header row above it).

The second bold line just changes the row to copy data into to that start row (was destinationLastRow + 1 ).

Here's the full code (section above in bold):

Sub Copy_New_Data()
''''''''  TeachExcel.com  ''''''''
'Copy all new rows from one worksheet to another.

Dim importSheet, destinationSheet As Worksheet
Dim importLastRow, importColumnCheck, destinationColumnCheck, _
importStartRow, destinationStartRow, curRow, destinationLastRow As Integer
Dim dataToCheck As Variant
Dim rng, rDel As Range


' ------------------------------------------------------------------- '
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| '
'           Change this section to work for your workbook.
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| '
' ------------------------------------------------------------------- '
'Set the worksheets
Set importSheet = Sheets("Import") 'worksheet to copy data from
Set destinationSheet = Sheets("backup") 'worksheet to paste new data

'Import data column to check
importColumnCheck = 1
'Destination data column to check
destinationColumnCheck = 1

'Start row on import sheet
importStartRow = 2
'Start row on destination sheet
destinationStartRow = 2
' ------------------------------------------------------------------- '
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| '
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| '
' ------------------------------------------------------------------- '


'Get last row from import worksheet
importLastRow = importSheet.Cells(Rows.Count, importColumnCheck).End(xlUp).Row

'Loop through range
For curRow = importStartRow To importLastRow

    'Get data to check
    dataToCheck = importSheet.Cells(curRow, importColumnCheck).Value

    'Get last row from destination sheet
    destinationLastRow = destinationSheet.Cells(Rows.Count, importColumnCheck).End(xlUp).Row

    'Check for duplicate
    With destinationSheet.Range(destinationSheet.Cells(destinationStartRow, destinationColumnCheck), destinationSheet.Cells(destinationLastRow, destinationColumnCheck))
        Set rng = .Find(What:=dataToCheck, _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

        If Not rng Is Nothing Then
            'Record already exists

            'mark rows for deletion
            If Not rDel Is Nothing Then
                Set rDel = Union(Range("A" & curRow), rDel)
            Else
                Set rDel = Range("A" & curRow)
            End If

        Else
        'New record, so
            'Insert row at top to insert new data
            destinationSheet.Rows(destinationStartRow).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
            ' copy it over
            importSheet.Range("A" & curRow).EntireRow.Copy destinationSheet.Range("A" & destinationStartRow)

            'mark rows for deletion
            If Not rDel Is Nothing Then
                Set rDel = Union(Range("A" & curRow), rDel)
            Else
                Set rDel = Range("A" & curRow)
            End If

        End If

    End With

Next curRow

'Delete rows that need to be deleted
'Un-comment the next line of code if you want to delete copied rows.
'rDel.EntireRow.Delete

End Sub

Hope this fixes things for you. If so, please mark this Answer as Selected - that guides others and gives you a reputation as a responsible user of the Forum (so you're more likely to get answers in future).

Discuss

Discussion

Did you try that? 
John_Ru (rep: 3992) Sep 26, '22 at 2:40 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login