Excel - ماكرو لفرز أوراق متعددة

القضية

لدي 11 ورقة في التفوق. 10 أوراق تحتاج إلى سحب المعلومات من sheet1.

هذا هو للطهاة في خدمة تقديم الطعام.

لديّ كلمة رئيسية في العمود "أ" للتمييز بين كل سطر من المعلومات.

ما أحتاجه هو ...

  • الورقة 2 و 3 لسحب السطر الكامل من الورقة 1 إذا كانت الكلمة في العمود "حار".
  • الورقة 4 و 5 لسحب السطر الكامل من الورقة 1 إذا كانت الكلمة في العمود "بارد".
  • ورقة 6 لسحب السطر الكامل من الورقة 1 إذا كانت الكلمة في العمود A هي "مجمعة".
  • الصفحتان 8 و 9 لسحب السطر الكامل من الورقة 1 إذا كانت الكلمة في العمود "المعجنات".
  • الورقة 10 لسحب السطر الكامل من الورقة 1 إذا كانت الكلمة في العمود A هي "Pres".

وتغطي بالفعل الأوراق الأخرى.

لقد أنشأت ماكرو لفرز الأوراق على أساس ثلاثة أعمدة. سيكون من الرائع أن يتم تشغيل هذا الماكرو تلقائيًا في كل مرة تتم فيها إضافة المعلومات إلى الورقة. ليس على سطر معين ولكن إلى أي منطقة من الورقة للحفاظ على المعلومات في الترتيب.

حل

جرب هذا الماكرو:

 Option Explicit Private Sub Worksheet_Change (ByVal Target As Range) Dim nxtRow As Integer 'حدد إذا ما كان التغيير إلى العمود H (8) إذا كان Target.Column = 8 ، ثم' إذا كان الجواب نعم ، حدد إذا كانت الخلية = Hot If Target.Value = "H" ثم "إذا كانت الإجابة بنعم ، ابحث عن الصف الفارغ التالي في الورقة 2 nxtRow = صفائح (2) .Range (" G "& Rows.Count) .End (xlUp) .Row + 1" نسخ الصف الذي تم تغييره ولصقه في الورقة 2 Target.EntireRow .Copy _ Destination: = Sheets (2) .Range ("A" & nxtRow) 'إذا كانت الإجابة بنعم ، ابحث عن الصف الفارغ التالي في الورقة 3 nxtRow = Sheets (3) .Range ("G" & Rows.Count) .End ( xlUp) .Row + 1 'نسخ الصف الذي تم تغييره ولصقه في الورقة 3 Target.EntireRow.Copy _ Destination: = Sheets (3) .Range ("A" & nxtRow) End If End إذا "حدد إذا كان التغيير في العمود H ( 8) إذا كان Target.Column = 8 ، ثم "إذا كانت الإجابة بنعم ، حدد إذا كانت الخلية = بارد إذا كان الهدف ..Value =" C "ثم" إذا كان "نعم" ، ابحث عن الصف الفارغ التالي في الورقة 4 nxtRow = الأوراق (4) .Range ("G" & Rows.Count). End (xlUp) .Row + 1 'انسخ الصف الذي تم تغييره ولصقه في الورقة 4 Target.EntireRow.Copy _ Destination: = Sheets (4) .Range ("A" & nxtRow)' إذا كانت الإجابة بنعم ، ابحث عن الصف الفارغ التالي في الورقة 5 nxtRow = Sheets (5) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1 "انسخ الصف الذي تم تغييره ولصقه في الورقة 3 Target.EntireRow.Copy _ Destination: = الأوراق (5) .Range ("A" & nxtRow) ينتهي إذا انتهى إذا كان "تحديد ما إذا كان التغيير إلى العمود H (8) إذا كان Target.Column = 8 ، ثم" إذا كان الجواب نعم ، حدد إذا كانت الخلية = عرض تقديمي إذا كان Target.Value = " P "Then" إذا كانت الإجابة بنعم ، ابحث عن الصف الفارغ التالي في الورقة 8 nxtRow = الأوراق (8) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1 "نسخ الصف الذي تم تغييره ولصقه في الورقة 8 Target .EntireRow.Copy _ Destination: = Sheets (8) .Range ("A" & nxtRow) End If End إذا "حدد إذا كان التغيير إلى العمود H (8) إذا كان Target.Column = 8 ، ثم" إذا كانت الإجابة بنعم ، حدد إذا كانت الخلية = Pastry If Target.Value = "PY" ثم "إذا كانت الإجابة بنعم ، ابحث عن الصف الفارغ التالي في الورقة 10 nxtRow = الأوراق (10) .Range (" G "& Rows.Count). End (xlUp) .Row + 1 'Copy تم تغيير الصف والصقه في الورقة 10 Target.EntireRow.Copy _ Destination: = Sheets (10) .Range ("A" & nxtRow) 'إذا كانت الإجابة بنعم ، ابحث عن الصف الفارغ التالي في الورقة 12 nxtRow = Sheets (11) .Range (" G "& Rows.Count). End (xlUp) .Row + 1 "نسخ الصف الذي تم تغييره ولصقه في الورقة 12 Target.EntireRow.Copy _ Destination: = Sheets (11) .Range (" A "& nxtRow) End If End إذا" إذا كان التغيير إلى العمود H (8) إذا كان Target.Column = 8 ، ثم "إذا كانت الإجابة بنعم ، حدد إذا كانت الخلية = مجمعة إذا كانت Target.Value =" B "ثم" إذا كانت الإجابة بنعم ، ابحث عن الصف الفارغ التالي في الورقة 6 nxtRow = الأوراق (6) .Range ("G" "& Rows.Count). End (xlUp) .Row + 1" نسخ الصف الذي تم تغييره ولصقه في الورقة 6 Target.EntireRow.Copy _ Destination: = Sheets (6) .Range ("A" & nxtRow) End If End If نهاية الفرعية 

بفضل Jlee1978 لهذه النصيحة.

المقال السابق المقالة القادمة

نصائح الأعلى