اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

  • 2 months later...
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

رابط هذا التعليق
شارك

  • 2 weeks later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information