Copy Records

[josros60]

Hi,

can i please get help modifying the below code to:

1. copy only whole rows but just upto certain column (for example my spreadsheet is from A:J, but only want to copy upto column F)
2. Once records are copy delete records from source sheet
3. copy values and no formulas

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
            
            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.

 

[Joe4]

To copy just columns A:F, try changing this row:

c.EntireRow.Copy shtDest.Cells(destRow, 1)

to this:

Range(Cells(c.Row, "A"), Cells(c.Row, "F")).Copy shtDest.Cells(destRow, 1)

and then to delete the source row afterwards, you can use a line like this.

c.EntireRow.Delete

However, you may have problem if you have consecutive rows that need to be copied/moved, as deleting a row moves all the rows below that up.
This might cause the 2nd in consecutive rows to be missed.

If that is the case, then instead of deleting the row, just clear the contents, i.e.

c.EntireRow.ClearContents

You would then have blank rows that you can delete or sort out after the end of the loop.

 

[josros60]

thank so much worked.

only problem having is for due date column and paid amounts is coying formulas instead of values (so showing #VALUE! error) any help on that.

 

[Joe4]

Try this:

Range(Cells(c.Row, "A"), Cells(c.Row, "F")).Copy 
shtDest.Cells(destRow, 1).PasteSpecial xlPasteValues

 

[josros60]

Thank you for your help. worked.

 

[Joe4]

You are welcome.