انشاء شيت تلقائي

[حسن البدوي0]

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

في زر اضافة يوجد كود من تصنيعي اريد التعديل عاليه بحيث يرحل بيانات العميل في الجدول كما موضح ثم يقوم بانشاء شيت جديد يحمل اسم العميل ويكون بداخله اصناف المخزن كما موضح في الشيت رقم3

انتبه من فضلك مشاركة مكررة .. تم بالفعل حذف المشاركة الأخرى 

اسعار العملاء.xlsm

[حسين مامون]

جرب

اسعار العملاء.xlsm

[حسن البدوي0]

استاذي العزيز اريد في شيت العميل ان يظهر اسم العميل

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

حرب هذا الملف

Option Explicit
Sub Add_Sheets()
    Dim A As Worksheet
    Dim T As Worksheet
    Dim Arr_sh(), BoL As Boolean
    Dim ro%, X%

    Set A = Sheets("Aoumala")
    Set T = Sheets("Tempete")

ro = A.Cells(Rows.Count, 2).End(3).Row
If Application.CountA(A.Range("H5:H9")) < 5 Then
  MsgBox "Fill all Informations About The The Client" & Chr(10) & _
     "In the range: " & A.Range("H5:H9").Address, 80
  Exit Sub
End If
ReDim Arr_sh(1 To Sheets.Count)
 For X = 1 To Sheets.Count
   Arr_sh(X) = Sheets(X).Name
 Next
   
   BoL = IsError(Application.Match(A.Range("H6"), Arr_sh, 0))
 If Not BoL Then
        MsgBox "This Sheet Is Already Exists"
        Exit Sub
 Else
      A.Range("H5:H9").Copy
      A.Range("A" & ro + 1).PasteSpecial Transpose:=True
      T.Copy After:=Sheets(Sheets.Count)
          With ActiveSheet
          .Name = A.Range("H6")
          .Range("D2") = .Name
          End With
      A.Select
      A.Range("H6:H9").ClearContents
      A.Range("H5") = A.Range("H5") + 1
      MsgBox "That is ALL"
 End If
End Sub

 

Badawi.xlsm

[حسن البدوي0]

اخي العزيز هذا الكود يعمل معي جيدا كل ما اريدة هو بعد كل عملية يجعل الخلية بدون قيمة لا يوجد بها شيئ

اسعار العملاء.xlsm

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

يجعل الخلية بدون قيمة لا يوجد بها شيئ

في ورقة الاكسل يوجد 

 1048576   ضف

16384  عامود

اي  1048576×  16384 = 17179869184  خلية    عن اي خلية تتكلم

[حسين مامون]

تفضل

اسعار العملاء (1).xlsm

[حسن البدوي0]

اخي حسين مامون انت فعلت اللازم ولاكن اخر طلب بعد اذنك اريد اسم العميل داخل الشيت وزر الرجوع كما موضح في الشيت رقم 3

55.xlsm

[حسين مامون]

تفضل

55.xlsm

[حسن البدوي0]

شكرا اساتذتي الكرام علي هذا المجهود الجبار