مساعده فى هذا الكود

[محمد عبد الناصر]

السلام عليكم ورحمة الله وبركاته ؛؛؛

الكود ده بينقل الارقام اللي اقل من 91 فى الشيت 2 عايز اكتب اقل من 90 الي 1 (90:1) بس مش عارف اعملها ياريت حد يساعدنى فيها

 

Sub CopyRows()
    Dim LR As Long, I As Long, X As Long
    LR = Sheets("Sheet1").Cells(Rows.Count, "g").End(xlUp).Row
    X = 5
    Application.ScreenUpdating = False
        Sheets("Sheet2").Rows("5:1000").ClearContents
        For I = 6 To LR
            If Cells(I, "g").Value > 91 Then Rows(I).Copy Sheets("Sheet2").Range("A" & X): X = X + 1
        Next I
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[ياسر العربى]

هل تقصد هكذا 

Sub CopyRows()
    Dim LR As Long, I As Long, X As Long
    LR = Sheets("Sheet1").Cells(Rows.Count, "g").End(xlUp).Row
    X = 5
    Application.ScreenUpdating = False
        Sheets("Sheet2").Rows("5:1000").ClearContents
        For I = 6 To LR
            If Cells(I, "g").Value < 90 And Cells(I, "g").Value >= 1 Then Rows(I).Copy Sheets("Sheet2").Range("A" & X): X = X + 1
        Next I
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[محمد عبد الناصر]

شكرااااااااااااااا استاذ ياسر

[سليم حاصبيا]

اثراءً للموضوع 

هذا الكود (ربما اسرع قليلاً)

Sub Filter_Me()
Sheets("Sheet2").Range("a:a").ClearContents
        With Sheets("Sheet1")
                .Activate
                .AutoFilterMode = False
                 lrg = .Cells(Rows.Count, "g").End(3).Row
                    .Range("g6").AutoFilter Field:=1, Criteria1:=">=1", _
                        Operator:=xlAnd, Criteria2:="<=90"
                    .Range("g6:g" & lrg).Copy Sheets("sheet2").Range("a5")
                    .AutoFilterMode = False
                    Application.CutCopyMode = False
         End With
End Sub