ترحيل حسب اسم الشيت (ج1)

ترحيل حسب اختيار اسم الشيت ج1

هناك العديد من الطرق التى يمكنك من خلالها ترحيل البيانات من شيت الى شيت آخر

وسنتحدث عن عده طرق  لترحيل البيانات حسب اسم الشيت

وسنكمل سرد عده طرق بمواضيع أخري

الطريقة التالية تعتمد على كتابة اسم الشيت بأحد الأعمدة أمام كل صف به بيانات ، مراد ترحيله للشيت الذى سيتم كتابه اسمه بهذا العمود

الشفرة كاملة كالتالي

'فضلا عند استخدامك للشفرات البرمجية يجب ذكر المصدر
'https://elshriefacademy.blogspot.com

Sub MZM_GOTO()
Dim S As String
Dim R As Integer, RR As Integer, c As Integer, CC As Integer
S = ActiveSheet.Name
Application.ScreenUpdating = False
Range("A6:M2000").ClearContents
With Sheet1
    For R = 2 To .Range("M2000").End(xlUp).Row
        
        If .Cells(R, "M") = S Then
            
            RR = RR + 1
            For c = 1 To 12
                CC = Choose(c, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
                Cells(RR + 5, c) = .Cells(R, CC)
            Next c
        End If
    Next R
End With
Application.ScreenUpdating = True
End Sub

النقاط الرئيسية بالشفرة أعلاه

1. النطاق ("A6:M2000") الذى به البيانات بدون رؤوس الجداول 
2. العمود الذى يسجل به اسم الشيت هو ( M )
3. يتم كتابة أرقام الأعمدة المراد ترحيلها بدءا من العمود الأول وحتى آخر عمود مراد ترحيله

تلميحات

السطر التالي بالشفرة أعلاه خاص بنطاق البيانات بالشيت الذى به البيانات 

Range("A6:M2000").ClearContents
 

السطر التالي تم تحديد العمود (M) وحتى الصف 2000 وهذا العمود خاص بتسجيل اسماء أوراق العمل المراد الترحيل إليها يمكنك التعديل عليه حسب النموذج الخاص بك

For R = 2 To .Range("M2000").End(xlUp).Row
 

السطر التالي بالشفرة أعلاه يمثل حلقه تكرارية بدء من العمود الأول الى العمود الـ (12) يمكنك بالطبع التعديل عليه كما تشاء ، حسب أعمدة الجدول بالمصنف الخاص بك

For c = 1 To 12
 

السطر التالي يتم كتابة أرقام الأعمدة بدء من الأول حتى آخر عمود مراد ترحيله بدون العمود الذى به اسماء أوراق العمل

CC = Choose(c, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
 

السطر التالي تم تحديد الصف السادس الذى سيتم لصق البيانات به بكل ورقة عمل مراد الترحيل إليها ، فيمكنك تغيير الرقم ( 5) 

Cells(RR + 5, c) = .Cells(R, CC)
 

كيف تعمل هذه الشفرة بشكل تلقائي بدون الحاجة الى ربطها بزر ؟

يتم كتابة اسم الشفرة فى حدث Activate بداخل حدث كل ورقة عمل مراد الترحيل اليها

واليك الشفرة المستخدمة

'فضلا عند استخدامك للشفرات البرمجية يجب ذكر المصدر
'https://elshriefacademy.blogspot.com

Private Sub Worksheet_Activate()
MZM_GOTO
End Sub