[RESOLVED] Cut & paste the data to new sheet if condition matches

Hi Experts,

I am looking for a macro that will do the things mentioned below
macro will be placed in macro.xlsm,both files are located in different places so the path will be hardcoded in the macro so that i can change it as per my needs
sheet name can be anything
Plz see the sample file & the output file


If column D of 1.xls equal to column E of 1.xls or column D of 1.xls equal to column F of 1.xls then cut that row & paste it to new sheet in 1.xls(Plz name the new sheet as output2)
(header will be same in new sheet also)




Thnx For the Help



https://drive.google.com/file/d/15LM...ew?usp=sharing
https://drive.google.com/file/d/1ifJ...ew?usp=sharing

you can test this to see if it does what you require

Code:

---

Dim wb As Workbook, output As Worksheet, rng As Range, rw As Long
Set wb = Workbooks("1.xls")  ' if already open
' OR
Set wb = Workbooks.Open("fullpath\1.xls")
rw = 2    ' don't check header row
With wb.Sheets(1)
    .Cells(1, 1).EntireRow.Copy output.Cells(1, 1)
    lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For rw = 2 To lastrow
        If .Cells(rw, 4) = .Cells(rw, 5) Or .Cells(rw, 4) = .Cells(rw, 6) Then
            If rng Is Nothing Then Set rng = .Cells(rw, 1).EntireRow
            Else: Set rng = Union(rng, .Cells(rw, 1).EntireRow)
        End If
    Next
If Not rng Is Nothing Then  '  some rows to move
    Set output = Sheets.Add
    output.Name = "output2"
    .Cells(1, 1).EntireRow.Copy output.Cells(1, 1)
    rng.Cut output.Cells(2, 1)
End If

---

Code:

---

Sub PART1()
Dim wb As Workbook, output As Worksheet, rng As Range, rw As Long
Set wb = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
rw = 2
With wb.Worksheets.Item(1)
    .Cells(1, 1).EntireRow.Copy output.Cells(1, 1)
    lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For rw = 2 To lastrow
        If .Cells(rw, 4) = .Cells(rw, 5) Or .Cells(rw, 4) = .Cells(rw, 6) Then
            If rng Is Nothing Then Set rng = .Cells(rw, 1).EntireRow
            Else: Set rng = Union(rng, .Cells(rw, 1).EntireRow)
        End If
    Next
If Not rng Is Nothing Then
    Set output = Sheets.Add
    output.Name = "output2"
    .Cells(1, 1).EntireRow.Copy output.Cells(1, 1)
    rng.Cut output.Cells(2, 1)
End If
wb.Save
wb.Close

End Sub

---

Compile error
expected end with

i must have missed the last line when i copy and pasted, after the last end if

Problem Solved