ارجو المساعدة في تعديل في الكود محتاجة بشرطين

[نسورالجو]

ورقة عمل Microsoft Excel جديد.xlsm

الشرط اﻻول في العمود T محتاج الشرط التاني U

 

[نسورالجو]

Private Sub CommandButton1_Click()
Range("a3:d200") = ""
Sheets("الصفحة الرئيسية").Select
For Each cel In Sheets("الصفحة الرئيسية").Range("t2:w300")
If cel.Value = "مراكز الإنتاج " Then
cel.Resize(1, 4).Copy
Sheets("توزيع المخزون").Activate
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
End If
Next
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1) = "اجمالي التصنيع"
Sheets("توزيع المخزون").Range("d" & Range("d" & Rows.Count).End(xlUp).Row + 1) = "اجمالي التصنيع"
For Each cel In Sheets("الصفحة الرئيسية").Range("t2:w300")
If cel.Value = "مراكز الإنتاج" Then
cel.Resize(1, 4).Copy
Sheets("توزيع المخزون").Activate
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
End If
Next
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1) = "اجمالي التصنيع"
Sheets("توزيع المخزون").Range("d" & Range("d" & Rows.Count).End(xlUp).Row + 1) = "اجمالي التجميع"
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1) = "اجمالي المراكز"
Sheets("توزيع المخزون").Range("d" & Range("d" & Rows.Count).End(xlUp).Row + 1) = "اجمالي المراكز"

For Each cel In Sheets("الصفحة الرئيسية").Range("t2:w300")
If cel.Value = "خدمات الانتاج" Then
cel.Resize(1, 4).Copy
Sheets("توزيع المخزون").Activate
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
End If
Next
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1) = "اجمالي خدمات الانتاج"
Sheets("توزيع المخزون").Range("d" & Range("d" & Rows.Count).End(xlUp).Row + 1) = "اجمالي خدمات الانتاج"
For Each cel In Sheets("الصفحة الرئيسية").Range("t2:w300")
If cel.Value = "خدمات التسويقية" Then
cel.Resize(1, 4).Copy
Sheets("توزيع المخزون").Activate
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
End If
Next
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1) = "اجمالي خدمات التسويقية"
Sheets("توزيع المخزون").Range("d" & Range("d" & Rows.Count).End(xlUp).Row + 1) = "اجمالي خدمات التسويقية"
For Each cel In Sheets("الصفحة الرئيسية").Range("t2:w300")
If cel.Value = "خدمات الادارية" Then
cel.Resize(1, 4).Copy
Sheets("توزيع المخزون").Activate
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
End If
Next
Sheets("توزيع المخزون").Range("a" & Range("a" & Rows.Count).End(xlUp).Row + 1) = "اجمالي خدمات الادارية"
Sheets("توزيع المخزون").Range("d" & Range("d" & Rows.Count).End(xlUp).Row + 1) = "اجمالي خدمات الادارية"
Sheets("توزيع المخزون").Range("d" & Range("d" & Rows.Count).End(xlUp).Row + 1) = "الاجمالي العــام"
End Sub

المطلوب التعديل في كود ترحيل بشرطين  الشرط اﻻول في العمود T محتاج الشرط التاني U

Microsoft Excel جديد.xlsm

[0d59eacf59]

جربت الكود في الاعلى ؟ 

 

 

 

 

 

 

 

 

 

 

Speed Test