Copy records to new available blank row

josros60

Well-known Member
Joined
Jun 27, 2010
Messages
778
Office Version
  1. 365
I have the code below works fine the only problem it overwrites the records already there and I want to keep old records, how to make to copy new records the next available blank row the new records copy:

VBA Code:
Sub COPY_PAIDINVOICES()On Error Resume Next




    Dim srchtrm As String
    Dim rng As Range, destRow As Long
    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range
    Dim i As Integer
    Dim Today As Date
    
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    Set shtSrc = Sheets("CDA_INVOICES")    'source sheet
    Set shtDest = Sheets("PAID_INVOICES")    'destination sheet
    destRow = 2 'start copying to this row




    'don't scan the entire column...
    Set rng = Application.Intersect(shtSrc.Range("H:H"), shtSrc.UsedRange)




    For Each c In rng.Cells
        If c.Value = "PAID IN FULL" Then
        
        'Range(Cells(c.Row, "A"), Cells(c.Row, "F")).Copy shtDest.Cells(destRow, 1)
        Range(Cells(c.Row, "A"), Cells(c.Row, "F")).Copy
        shtDest.Cells(destRow, 1).PasteSpecial xlPasteValues
          c.EntireRow.ClearContents
            'c.EntireRow.Copy shtDest.Cells(destRow, 1)
          
            destRow = destRow + 1




        End If
    Next
    
    With Application
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    Application.CutCopyMode = False
    
    Sheets("CDA_INVOICES").Range("H14").Select
End Sub

thanks.
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
remove the destRow=2 near the top.
In the For Each c... loop, put this:
destRow=Schdest.range("A1048576").end(xlup).row+1

also clear destRow=destRow+1
 
Upvote 0
Hi

tried getting error 424 object required guess I put the line in wrong place here how it is,

VBA Code:
For Each c In rng.Cells
     destRow = Schdest.Range("A1048576").End(xlUp).Row + 1

        If c.Value = "PAID IN FULL" Then

when error highlight this line
VBA Code:
destRow = Schdest.Range("A1048576").End(xlUp).Row + 1

i removed the two lines you mentioned destRow1/2.

Thank you
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,953
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top