نقل البيانات حسب الحالة من شيت الى شيت اخر

[عبدالودود لطيف]

السلام عليكم

عندي شيت يحتوي على بيانات

اريد نقل كل حالة في شيت

وكما موضح بالمثال  (الملف) المرفق

مشكورين وجزيتم خيرا

 

حسب الحالة.rar

[سليم حاصبيا]

جرب هذا الملف

 

Salimحسب الحالة.rar

[عبدالودود لطيف]

جزيت خيرا   -  حيا الله استاذ سليم - مشكور

استاذنا ارجو الاطلاع على الملف الذي جرى عليه التعديل

اذ توسع راس الجدول - حسب متطلبات العمل - واعتذر منك عل هذا التغيير

الكود حسب طلبي الاول ممتاز 

وحقيفة حاوت التغيير ما استطعت 

 

Salimحسب الحالة.rar

تم تعديل أغسطس 28, 2017 بواسطه عبدالودود لطيف

[سليم حاصبيا]

نم التعديل على الماكرو حسب الطلب

Option Explicit

Sub Tarhil_Salim_Modifier()
Dim S_S As Worksheet
Dim lr%, lr1%, i%, k%, my_col%, m%
Dim Opt_col%
Set S_S = Sheets("البيانات")
lr = S_S.Cells(Rows.Count, 1).End(3).Row
my_col = S_S.Cells(1, 3)
Opt_col = Application.Match("الحالة", S_S.Range("a2:xfd2"), 0)
 If Not IsNumeric(my_col) Or my_col < 2 Then Exit Sub
 my_col = Int(my_col)
 
        For i = 2 To Sheets.Count
          Sheets(i).Cells.Clear
        Next
        
        For i = 2 To Sheets.Count
         S_S.Cells(2, 1).Copy Sheets(i).Cells(2, 1)
         S_S.Cells(2, Opt_col).Copy Sheets(i).Cells(2, my_col)
      Next
     
        For i = 2 To Sheets.Count
            k = 3
            m = 3
             Do Until S_S.Range("a" & k) = ""
                   If S_S.Cells(k, Opt_col) = Sheets(i).Name Then
                         Sheets(i).Cells(m, 1) = S_S.Cells(k, 1)
                         Sheets(i).Cells(m, my_col) = S_S.Cells(k, Opt_col)
                         m = m + 1
                   End If
                  k = k + 1
             Loop
             Sheets(i).Columns(my_col).AutoFit
          Next
End Sub


Private Sub CommandButton1_Click()
Tarhil_Salim_Modifier
End Sub

الملف مرفق

 

Salimحسب 2الحالة.rar

[عبدالودود لطيف]

السلام عليكم

مشكور استاذ سليم

مشكور على سرعة الرد والحل

عندي استفسار : وضعت بيانات بين خانة b ال خانة x

وضغت في خانة c1  رقم 25 التي تمثل الحالة 

ووضغط على الزر ، تم الترحيل بدون البيانات بين الخالة b الى x

Salimحسب الحالة.rar

[سليم حاصبيا]

2 دقائق مضت, عبدالودود لطيف said:

السلام عليكم

مشكور استاذ سليم

مشكور على سرعة الرد والحل

عندي استفسار : وضعت بيانات بين خانة b ال خانة x

وضغت في خانة c1  رقم 25 التي تمثل الحالة 

ووضغط على الزر ، تم الترحيل بدون البيانات بين الخالة b الى x

Salimحسب الحالة.rar

جسب الكود يحب ان تبدأ الاسماء من الخلية A3 والحالة في اي عامود اخر ( اذا اردت يمكن تغيير الكود ليبدأ ابنما تريد)

[سليم حاصبيا]

الكود المطلوب لاي حالة

Option Explicit

Sub Tarhil_Salim_Modifier2()
Dim S_S As Worksheet
Dim lr%, lr1%, i%, k%, m%
Dim Off_col%, Int_Col%, My_Col%
Set S_S = Sheets("البيانات")
lr = S_S.Cells(Rows.Count, 1).End(3).Row

My_Col = S_S.Cells(1, 3)
Int_Col = Application.Match("الاسم", S_S.Range("a2:xfd2"), 0)
Off_col = Application.Match("الحالة", S_S.Range("a2:xfd2"), 0)

 If Not IsNumeric(My_Col) Or My_Col < 2 Then Exit Sub
 My_Col = Int(My_Col)
 
        For i = 2 To Sheets.Count
          Sheets(i).Cells.Clear
        Next
        
        For i = 2 To Sheets.Count
         S_S.Cells(2, Int_Col).Copy Sheets(i).Cells(2, 1)
         S_S.Cells(2, Off_col).Copy Sheets(i).Cells(2, My_Col)
      Next
     
        For i = 2 To Sheets.Count
            k = 3
            m = 3
             Do Until S_S.Cells(2, Int_Col).Offset(k - 3) = ""
               
                   If S_S.Cells(k, Off_col) = Sheets(i).Name Then
                         Sheets(i).Cells(m, 1) = S_S.Cells(k, Int_Col)
                         Sheets(i).Cells(m, My_Col) = S_S.Cells(k, Off_col)
                         m = m + 1
                   End If
                  k = k + 1
             Loop
             Sheets(i).Columns(My_Col).AutoFit
          Next
End Sub

Private Sub CommandButton1_Click()
Tarhil_Salim_Modifier2
End Sub

Salimحسب 3الحالة.rar

الملف مرفق

 

[عبدالودود لطيف]

السلام عليكم

لم تنقل البيانات كلها تم نقل البيانات فقط التي موجودة في خانة الاسم والحالة

والبيانات الباقية لم تنقل عندي بيانات من خلية الاسم الى خلية الحالة

لم تنقل كما في المشاركة الاخيرة

تم تعديل أغسطس 28, 2017 بواسطه عبدالودود لطيف

[سليم حاصبيا]

6 دقائق مضت, عبدالودود لطيف said:

السلام عليكم

لم تنقل البيانات كلها تم نقل البيانات فقط التي موجودة في خانة الاسم والحالة

والبيانات الباقية لم تنقل عندي بيانات من خلية الاسم ال خلية الحالة

لم تنقل

انت اردت ذلك (حسب ما فهمت من مشاركتك)

اذا كنت تريد غير ذلك ارفع ملفاً (نموذجاً)فيه بعض البيانات بالاضافة الى الاسم والحالة

و في الورقتين الثانية والثالثة ما تتوقع ان يكون فيهما

[عبدالودود لطيف]

السلام عليكم

ارفق ملف والنتائج المتوقعة

Salimحسب 3الحالة.rar

[سليم حاصبيا]

ربما كان المطلوب

 

Salimحسب 4الحالة.rar

[عبدالودود لطيف]

تسلم - تمام - هو المطلوب