Copy entire Row IF!

Zshan

New member
Joined
Apr 28, 2020
Messages
31
Reaction score
0
Points
0
Excel Version(s)
Excel10
HI,

I am trying to copy entire row in VBA macro without functions just values if it matches three critareas.

if VALUE1>0 VALUE2>=5 VALUE3<-9 in same row it should be copied from "DATA" to "EX" else nothing!

I am also attaching file named "TRY.xlsm" which has details,

any suggestions would be helpful!

Thanks,
 

Attachments

  • TRY.xlsm
    11 KB · Views: 9
Code:
Option Explicit


Sub Rough()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("DATA")
    Set s2 = Sheets("EX")
    Dim i As Long, lr As Long, lr2 As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 3 To lr
        With s1
            If .Range("E" & i) > 0 And .Range("F" & i) >= 5 And .Range("O" & i) < -9 Then
                lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
                .Range("A" & i).EntireRow.Copy
                s2.Range("A" & lr2 + 1).PasteSpecial xlPasteValues
            End If
        End With
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Complete"
End Sub
 
Hi,

Thanks for the help its realy great but it has minor problem!
if you take a look and suggest something it would be really nice.
I am uploading different file with new data.
Thanks,
 

Attachments

  • DIF.xlsm
    21.2 KB · Views: 11
Really should explain your issues in the post and not make people open a file to read your issue. It prevents search engines from seeing the issues.

Anyway

Change this line

Code:
lr = s1.Range("A" & Rows.Count).End(xlUp).Row

to

Code:
lr = s1.Range("B" & Rows.Count).End(xlUp).Row
 
Last edited:
Back
Top