كيف يمكن نسخ الصفوف من أوراق عمل متعددة وفقًا لمعايير محددة إلى ورقة عمل جديدة؟

افترض أن لديك ملفًا يحتوي على ثلاث أوراق عمل بنفس التنسيق الموضح في لقطة الشاشة أدناه. الآن، تريد نسخ جميع الصفوف من هذه الأوراق التي يحتوي عمودها C على النص «Completed» إلى ورقة عمل جديدة. كيف يمكنك إنجاز هذه المهمة بسرعة وسهولة دون اللجوء إلى النسخ واللصق اليدوي لكل ورقة على حدة؟

نسخ الصفوف من أوراق عمل متعددة بناءً على معايير إلى ورقة جديدة باستخدام كود VBA

---

نسخ الصفوف من أوراق عمل متعددة بناءً على معايير إلى ورقة جديدة باستخدام كود VBA

يمكنك الاستفادة من كود VBA التالي لنسخ الصفوف المحددة من جميع أوراق العمل في الملف استنادًا إلى شرط معيّن، ولصقها في ورقة عمل جديدة. يُرجى اتباع الخطوات التالية:

1. اضغط مع الاستمرار على مفتاحَيALT + F11 لفتح نافذةMicrosoft Visual Basic for Applications.

2. انقرإدراج > وحدة نمطية (Module)، ثم الصق الكود التالي في نافذة الوحدة النمطية.

كود VBA: نسخ الصفوف من أوراق متعددة بناءً على معايير إلى ورقة جديدة

Public Sub CopyRows_ValuesAndNumberFormats()
Dim xWs As Worksheet
Dim xCWs As Worksheet
Dim xRg As Range
Dim xStrName As String
Dim xRStr As String
Dim xRRg As Range
Dim xC As Integer
On Error Resume Next
Application.DisplayAlerts = False
xStr = "Kutools for Excel"
xRStr = "Completed"
Set xCWs = ActiveWorkbook.Worksheets.Item(xStr)
If Not xCWs Is Nothing Then
    xCWs.Delete
End If
Set xCWs = ActiveWorkbook.Worksheets.Add
xCWs.Name = xStr
xC = 1
For Each xWs In ActiveWorkbook.Worksheets
    If xWs.Name <> xStr Then
        Set xRg = xWs.Range("C:C")
        Set xRg = Intersect(xRg, xWs.UsedRange)
        For Each xRRg In xRg
            If xRRg.Value = xRStr Then
               xRRg.EntireRow.Copy
               xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats
               xC = xC + 1
            End If
        Next xRRg
    End If
Next xWs
Application.DisplayAlerts = True
End Sub

ملاحظة: في الكود أعلاه:

• النص "Completed" في هذاxRStr = «Completed»النص البرمجي يشير إلى الشرط المعيّن الذي تريد نسخ الصفوف بناءً عليه؛
• C:C في هذاSet xRg = xWs.Range(«C:C»)، يشير النص البرمجي إلى تحديد العمود الذي يحتوي على الشرط.

3. بعد ذلك، اضغط على مفتاحF5 لتشغيل هذا الكود، وسيتم نسخ ولصق جميع الصفوف التي تحقق الشرط المعيّن في ورقة عمل جديدة باسم Kutools لـ Excel داخل المصنف الحالي. راجع لقطة الشاشة:

---

---

مقالات ذات صلة إضافية حول سحب أو نسخ البيانات: