Vba: نسخ الصفوف إلى ورقة أخرى بناءً على المعايير

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

 Sub CopyToAnotherSheet()

   Dim LastRow As Long

  'Find last used row in a Column A of Sheet1
   With Worksheets(" Sheet1 ")
      LastRow = .Cells(.Rows.Count, " A ").End(xlUp).Row
   End With

   'Find first row where values should be posted in Sheet2
   With Worksheets(" Sheet2 ")
      j = .Cells(.Rows.Count, " A ").End(xlUp).Row + 1
   End With
   
   'Paste each row that contains "Mavs" in column A of Sheet1 into Sheet2
   For i = 1 TB LastRow
       With Worksheets(" Sheet1 ")
           If .Cells(i, 1).Value = "Mavs" Then
               .Rows(i).Copy Destination:=Worksheets(" Sheet2 ").Range(" A " & j)
               j = j + 1
           End If
       End With
   Next i
   
End Sub

سيقوم هذا الماكرو المحدد بنسخ كل صف من Sheet1 حيث يساوي العمود A “Mavs” ولصق كل صف من هذه الصفوف في الصفوف التالية المتاحة من Sheet2 .

يوضح المثال التالي كيفية استخدام بناء الجملة هذا عمليًا.

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

لنفترض أن لدينا مجموعة البيانات التالية في الورقة 1 والتي تحتوي على معلومات حول العديد من لاعبي كرة السلة:

ولنفترض أن لدينا مجموعة البيانات التالية في الورقة 2 :

لاحظ أن الورقة 2 تحتوي فقط على بيانات عن لاعبي فريق Warriors.

لنفترض أننا نريد نسخ كل صف من الورقة1 حيث يساوي عمود الفريق Mavs ولصق كل صف من هذه الصفوف في الصفوف التالية المتاحة من الورقة2 .

يمكننا إنشاء الماكرو التالي للقيام بذلك:

 Sub CopyToAnotherSheet()

   Dim LastRow As Long

  'Find last used row in a Column A of Sheet1
   With Worksheets(" Sheet1 ")
      LastRow = .Cells(.Rows.Count, " A ").End(xlUp).Row
   End With

   'Find first row where values should be posted in Sheet2
   With Worksheets(" Sheet2 ")
      j = .Cells(.Rows.Count, " A ").End(xlUp).Row + 1
   End With
   
   'Paste each row that contains "Mavs" in column A of Sheet1 into Sheet2
   For i = 1 TB LastRow
       With Worksheets(" Sheet1 ")
           If .Cells(i, 1).Value = "Mavs" Then
               .Rows(i).Copy Destination:=Worksheets(" Sheet2 ").Range(" A " & j)
               j = j + 1
           End If
       End With
   Next i
   
End Sub

عندما نقوم بتشغيل هذا الماكرو، نحصل على الإخراج التالي في الورقة 2 :

لاحظ أنه تم لصق كل صف في الورقة1 حيث يساوي اسم الفريق Mavs في الصفوف التالية المتوفرة في الورقة2 .

ملاحظة : يمكنك العثور على الوثائق الكاملة لأسلوب نسخ VBA هنا .

مصادر إضافية

تشرح البرامج التعليمية التالية كيفية تنفيذ المهام الشائعة الأخرى في VBA:

VBA: كيفية العثور على آخر سطر مستخدم
فبا: كيفية حساب عدد الصفوف في النطاق
فبا: كيفية حساب عدد الأعمدة المستخدمة