مساعده بخصوص ترحيل بيانات

[yamz]

السلام عليكم اساتذتى الاجلاء

كل عام وانتم بخير

رجاء مساعدتى فى الملف المرفق

حيث اريد ترحيل البيانات من شيت الى اخر

مرفق ملف يوضح المطلوب

yehia.rar

[عبد الفتاح كيرة]

السلام عليكم

تفضل أخى المرفق

اتبع الآتى :

1- اختر من شيت بيانات أساسية اسم الشركة و حدد الاسم المراد

2 - اضغط زر تقرير

من إبداعات أخينا خبور خير حفظه الله

kemas.zip

[yamz]

السلام عليكم

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

المطلوب :

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

مع الاخذ فى الاعتبار ان البيانات كبيرة ممكن تصل الى 1000 سطر

مش عارف المعلومة وصلت ولا لسه وانا اسف علشان مش بعرف اشرح كويس

[yamz]

للرفع

[yamz]

للرفع 2

[طارق محمود]

أبشر أخي يحي

إن شاء الله سأرفق الحل قريبا

[طارق محمود]

السلام عليكم

هذا هو الكود

Sub Macro1()

'

' Macro1 Macro

'

Dim compn As Range, x(999) As String

'On Error Resume Next

Worksheets("Sheet1").Select



 Set compn = Range("C3", [C10000].End(xlUp))


	i = 0 ' counter

	For Each c In compn ' Company names

 	i = i + 1 ' counter


 	For j = 1 To i

 	If x(j) = c.Value Then i = i - 1: GoTo 100

 	Next j

 	x(i) = c.Value

100

	Next c

	cmp_Nu = i ' total Company number


	wshs = Worksheets.Count

	For i = 1 To cmp_Nu

 	For j = 1 To wshs

 	If Worksheets(j).Name = x(i) Then GoTo 200

 	Next j

 add_n_sht (x(i)) 	'in case no sheets in this name

200

	Next i

Sheets("sample").Visible = Hidden


Sheets("Sheet1").Select

Qaid_No = [A10000].End(xlUp).Row - 2

Last_sh = [A1].Value 	' Last shifted


'Copy & Paste the Data

For qq = Last_sh + 1 To Qaid_No

	c_nam = Range("C" & qq + 2).Value


	Range("A" & qq + 2, "Q" & qq + 2).Copy

	Sheets(c_nam).[A10000].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas

	[A1].Value = [A1].Value + 1

Next qq

	Application.CutCopyMode = False

	[B3].Select

End Sub

Function add_n_sht(n_sht)

	Sheets("sample").Visible = True

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

	wshs = Worksheets.Count

	Sheets("sample").Copy Before:=Sheets(wshs)

	ActiveSheet.Name = n_sht

	[C1].Value = n_sht

End Function

مع ملاحظة أن الخلية A1 تحتوي علي 0

أي عدد القيود (البيانات) المرحلة =0

مثلا لو عندك 12 بيان

وضغطت الزر لترحيلهم سيكون قيمة الخلية A1 = 12 بعد ترحيلهم

ثم أضفت 8 بيانات أخري حتي 20

وضغطت الزر للترحيل مرة أخري

فلن يرحل إلا البيانات من 13 إلي 20

وسيكون قيمة الخلية A1 = 20 بعد ترحيلهم

وهكذا

وطبعا تستطيع يدويا تغيير قيمة هذه الخلية A1

لترحيل البيانات مثلا بداية من البيان كذا أو كذا

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

yehia.rar

[yamz]

السلام عليكم ورحمة الله وبركاته

استاذى الفاضل طارق

بارك الله فيك وزادك من علمه وجزاك الله كل خير

فعلا هذا مااردته وسوف اطبقه كما هو لانى للاسف الشديد لسه مبتدئ فى موضوع الاكواد

وهاحاول افهم الكود على قدر فهمى لكى استعمله فى ملفات اخرى قريبا

كل الشكر لك ولتعبك معى