اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

مساعدة من عمالقة المنتدى


seao

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

ارجو افادتى بكيفية اضافة ورقة جديدة اذا كان العميل جديد يتم التعامل معة لاول مرة وترحيل بيانته اليها

اما اذا كان قد سبق التعامل معة سابقا " اى لة ورقة عمل خاصة بة مسبقة " يتم ترحيل بيانات الفاتورة الى الورقة الخاصة بة بكل البيانات .

وايضا يكون هناك رابط تشعبى عند الضغط علية للذهاب الى صفحة العميل

ارجوا ان لا اكون قد اثقلت عليكم بطلباتى ولكنى واثق من قدرتكم فى منتدانا على الافادة

Book1.rar

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

السلام عليكم

اخى الكريم

غيرت لك المعادلة التي بالعمود G لتكون أكثر شمولا

وتكون معتمدة علي البيانات في ورقة home فقط ولتجنب إعتمادها علي الورقات التالية

وبفرض أن التاريخ طبعا مسجل بالترتيب من الأصغر للأكبر

تم عمل كود الترحيل لورقة العميل

وإنشاء ورقة جديدة إن لم يكن للعميل ورقة من قبل

وذلك عن طريق عمل ورقة ثابتة بالملف إسمها Sample مخفية

وفي حالة إن لم يكن للعميل ورقة من قبل ، نظهر تلك الورقة ونأخذ منها نسخة في آخر الملف ونضع في النسخة إسم العميل في الخلية B2

ثم نعيد إخفاء الورقة Sample

فضلت الإحتفاظ بالبيانات بعد ترحيلها (عدم مسحها من ورقة home بعد ترحيلها)

مع إضافة تنبيه أن هذا البيان سبق ترحيله (إن وجد هذا)

هذا هو الكود

Sub Shift()

Dim CL_Name(999), Inv_Num(999), In_Date(999), In_Amnt(999) As Variant


Worksheets("home").Select

Reg_No = [C10000].End(xlUp).Row - 3

[C10000].End(xlUp).Select


'==============	READ DATA   =============

For i = 1 To Reg_No

	CL_Name(i) = Range("C" & i + 3).Value

	Inv_Num(i) = Range("D" & i + 3).Value

	In_Date(i) = Range("E" & i + 3).Value

	In_Amnt(i) = Range("F" & i + 3).Value

Next i


'______________________________________________

For qq = 1 To Reg_No


	x = Worksheets.Count


' =============   Write Data   ===============

	For i = 1 To x

	If Worksheets(i).Name = CL_Name(qq) Then GoTo 100

	Next i

   add_n_sht (CL_Name(qq)) 	'In case no sheets in this name

100


	Worksheets(CL_Name(qq)).Select

	Last_R = [A10000].End(xlUp).Row + 2


 	For j = 6 To Last_R


    	If Range("A" & j).Value = Inv_Num(qq) And Range("B" & j).Value = In_Date(qq) Then ' Check Previous Data

        	MsgBox ("هذا اليان برقم الفاتورة " & Inv_Num(qq) & Chr(10) & "والتاريخ" & _

        	In_Date(qq) & Chr(10) & "، سبق تسجيله من قبل " & Chr(10) & " لايمكن إعادة التسجيل")

        	GoTo 150

    	End If


	Next j

        	[A10000].End(xlUp).Select


        	ActiveCell.Offset(1, 0).Value = Inv_Num(qq)

        	ActiveCell.Offset(1, 1).Value = In_Date(qq)


        	If Inv_Num(qq) = "توريد نقدية" Then

            	ActiveCell.Offset(1, 3).Value = In_Amnt(qq)

        	Else

            	ActiveCell.Offset(1, 2).Value = In_Amnt(qq)

        	End If


150

Next qq


Sheets("home").Select


End Sub


Function add_n_sht(n_acc)

 x = Worksheets.Count

    	Sheets("Sample").Visible = True

	Sheets("sample").Select 'in case no sheets in this name


	Sheets("sample").Copy after:=Sheets(x)

	ActiveSheet.Name = n_acc

	[B2].Value = n_acc

	Sheets("Sample").Visible = False

End Function

بقي موضوع الرابط التشعبى لم أجد الوقت لضبطه

تفضل المرفق أيضا وبه الكود

يبدو ان الرفع به مشكلة بالمنتدي

تجد المرفق علي الرابط

http://www.4shared.com/file/rhOE3jNs/___online.html

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information