نقل صف بأكمله إلى ورقة أخرى بناءً على قيمة الخلية

[mohamadhaje]

السلام عليكم ورحمة الله وبركاته ارجو المساعدة في نقل صف كامل الى ورقة اخرى عندما تكون قيمة الخلية محددة وفي ملفي عندما تكون قيمة الخلية منفذ تنتقا تلقائيا الى الورقة الثنية وشكرا لكم مسبقا على المساعدة علما انني استخدمت هذا الكود ولم يعمل

Sub Cheezy()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "منفذ" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "منفذ" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

تطبيق طلبات.xlsx

[حسونة حسين]

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

عدل هذا السطر

 Set xRg = Worksheets("Sheet1").Range("C1:C" & I)

الى

 Set xRg = Worksheets("Sheet1").Range("E1:E" & I)