Copy data and paste it to next sheet with conditions

[HaroonSid]

hi,
I am using below code to copy paste data one sheet to next sheet

[/Option Explicit
 
Sub CopyRow()
Call CopyFormulaAndPasteAsValue
    Dim lastrowSrc As Long
    Dim lastrowDest As Long
     
    lastrowSrc = Sheets("sheet1").Range("c" & Rows.Count).End(xlUp).Row
     
    lastrowDest = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
     
     'Copy row
    Sheets("sheet1").Range("A7:i" & lastrowSrc).EntireRow.Copy Sheets("sheet2").Range("A" & lastrowDest)
     
End Sub

"sheet1" range A7:A have unique number ( like 1-100000000)
if from sheet1.range("A7:A"), any number found in Sheet2.range.("A:A")
then appers a msgbox with "number already added"
if not found then
copy paste data

thanx

[Winon]

Hi HaroonSid,

There could be a variety of issues at play here, and I don't believe any of us on the Forum would like to enter a guessing solution.

Please could you attach a sample workbook.

Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate.

Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.

Thank you.

[HaroonSid]

Hi, winnon
OK I change my requirement

No
In sheet2 range(A4:A) if duplicates find then delete the entire column only with duplicates

Thabx

[Winon]

Thank you for the feedback, HaroonSid,

Please try the Code Below. I think you meant delete duplicates within a Column, and not really the whole Column.

Sub DelDups()
Dim Lr As Long

Lr = Sheet2.Range("A4:A" & Rows.Count).End(xlUp).Row

    Sheet2.Select
    Sheet2.Range("A4" & Lr).Select
    Sheet2.Range("$A$4" & Lr).RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A4").Select
End Sub

Regards.

[HaroonSid]

Sorry for my wrong question,
I want to delete the entire row with duplicate values

[Winon]

Then please try the Code below:

Option Explicit
    Public Sub DeleteDuplicateRows()
    Dim A As Long
    Dim B As Long
    Dim C As Variant
    Dim Rng As Range
    Dim Lr As Long
    
    Lr = Sheet2.Range("A4:A" & Rows.Count).End(xlUp).Row
    
    On Error GoTo EndMacro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheet2.Range("A4:Z4" & Lr).Select
    Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
    ActiveSheet.Columns(ActiveCell.Column))
    Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")
    B = 0
    For A = Rng.Rows.Count To 2 Step -1
    If A Mod 500 = 0 Then
        Application.StatusBar = "Processing Row: " & Format(A, "#,##0")
    End If
    C = Rng.Cells(A, 1).Value
   
    If C = vbNullString Then
        If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
            Rng.Rows(A).EntireRow.Delete
            B = B + 1
        End If
    Else
        If Application.WorksheetFunction.CountIf(Rng.Columns(1), C) > 1 Then
            Rng.Rows(A).EntireRow.Delete
            B = B + 1
        End If
    End If
    Next A
EndMacro:
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Duplicate Rows Deleted:= " & CStr(B), vbOKOnly, ("Confirmation of Deletions")
    Sheet2.Range("A4").Select
    Application.ScreenUpdating = True
    End Sub

Regards.

[HaroonSid]

yes
now working perfectly

thanx alot for your hard work..

[Winon]

You are welcome HaroonSid, glad I could help.

Have a great day!

Regards.