احمدزمان

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

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

تاكد من اسم الملف الموجود في الرساله

و تاكد من اسم الماكرو المرتبط بالزر

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

في الخلية M1

غير كلمة البيان الى نوع العملية

حيث ان الجدول لا يوجد به كلمة البيان

مع التحية

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

ضع الدالة

=SUM(N4;C5;K5)-SUM(G5;L5)

ثم اسحبها للاسفل

مع التحية

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

Sub Add_One()
Dim FR
For FR = 10 To 50
Cells(FR, 3) = Val(Cells(FR, 3)) + 1
Next
MsgBox "plus 1 add to all"

End Sub

زائد1.xlsm

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

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

مثال

NN ممكن يون اسم عامود اورمز انت واضعه وغيرها

لذلك لم نفهم المطلوب

فضلا

التعديل الى مسميات اعمدة واضحة ليتمكن الاخوة من مساعدتك

آمين يارب

نحن و انت وجميع المسلمين

اخي الكريم

الدالة 

SUBSTITUTE

تقوم باستبدال احرف اي نص بقيمة جديدة

و انت اردت التخلص من السطر الجديد و هو مفتاح انتر Emter 

وهذا المفتاح يرمز له في كود المناتيح بـ Char(10)

لذلك تقوم الدالة باستبداله الى " -" في اي مكان في النص

جزاك الله خيرا

اعتذر ان لم استطع الرد على اي نسائل آخر حيث انني متوجه الى الحج بعد قليل - و البركة في بقية الاخوة في المنتدى ,,, دمتم بخير

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

في الخلية Q3

ضع الدالة التالية

=SUBSTITUTE(TRIM(P3);CHAR(10);" -")

قد يكون هذا طلبك

و الله اعلم

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

تقبل الله من الجميع

=INDEX(D3:M3;;MATCH(MAX(D5:M5);D5:M5;0))

اعلى-ادنى.xlsx

23 ساعات مضت, عبدالله صباح said:

جزاك الله خيرا

وزادتكم الله شأنا وعلماً

رفعك الله ورضى الله عنك

تمام

العمل 100 %

اللهم آمين

انا و انت و جميع المسلمين

شكرا لك

اخي عبدالله كللامك مظبوط

يوجد خطاء تم تعديله

و كان الخطاء في الحلقة الدائرية للتاكد من خلو الخلية الهدف من اي بيانات للكتابه بها

سامحنا ... كل ابن آدم خطاء

البرنامج.xlsm

طيب اراجعه ان شاء الله

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

اسعد الله صباحكم بكل خير

حاول التالي

1

ادخل الى النموذج للنقل و من قائمة اسماء الاوراق اعد اختيار اسم الورقة ((بنزين))

2

تاكد ان اسم الورقة ((بنزين)) ليس به مسافة في آخر الاسم او بعد الاسم

و ان شاء الله تظبط

وفي انتظار ردك

جزاك الله خيرا

تم التعديل كما طلبت

في المرفق

البرنامج.xlsm

‏الاثنين‏، 5‏/7‏/2021م الموافق ‏26‏/11‏/1442هـ

 طريقة الاستخدام

يتم فتح الملفين : البرنامج و البودرة

من ملف البرنامج الذهاب الى ورقة TransPorter

 اضغط على خطوة 1

سوف يتم تحديث بيانات القوائم المنسدلة ببيانات جميع الملفات المفتوحة من اسم الملف و أسماء الأوراق في ككل ملف

ابدء بتعبئة البيانات في الجدول كامل

حدد أسماء الملفات المصدر و الوجهة و أسماء الأوراق المنقولة منها البيانات و اسم الرقة الهدف التي سوف توضع بها البيانات

ثم

اضغط زر ابدء نقل البيانات

يتم نقل البيانات من جميع الأوراق الى الورقة الحالية

 مع التحية

 الصورة للشاشة

 الاكواد المستخدمة

'عمل قائمة اسماء الملفات
Application.ScreenUpdating = False
WBK1 = ActiveWorkbook.Name
Set TS = Workbooks(WBK1).Sheets("TransPorter")
TS.Unprotect 'Password:=Range("PW")
TS.Range("A4:B99").ClearContents
R = 4
For WB = 1 To Workbooks.Count
BN = Workbooks(WB).Name
For Sh = 1 To Workbooks(BN).Sheets.Count
TS.Cells(R, 1) = BN
TS.Cells(R, 2) = Workbooks(BN).Sheets(Sh).Name
R = R + 1
Next Sh
R = R + 1
Next WB
'TS.Range("AB4").ClearContents
TS.Range("K3") = WBK1
[I3] = ""
[H6] = ""
[K6] = ""
Application.ScreenUpdating = True
'Application.Run "Data_TransPorter01_Clear"
'Application.Run "Protct"
ActiveSheet.EnableSelection = xlUnlockedCells

--

Dim WB1N, WB2N, WB3N, FDT, TDT, DTC, FC1, FC2, TC, TR
Dim TSH, SHN, CC, CC2, CC3
Dim RN1 As Range
If Sheets("TransPorter").Range("Q14") = False Then
QQ = Sheets("TransPorter").Range("Q15").Text
MsgBox QQ, vbMsgBoxRight, "أكمل البيانات المطلوبة"
Exit Sub
End If
'CreateObject("Wscript.shell").Popup "إنتظر قليلاً حتى الإنتهاء من معالجة البيانات", 0, "إنتظار !!!!", vbExclamation
WB1N = Range("I3").Text
WB2N = Range("K3").Text
WB3N = ActiveWorkbook.Name 'اسم ملف ورقة الأوامر
ORDERSHET = ActiveSheet.Name 'ورقة الإعدادات او الأوامر
TSN = Range("K4").Text
Set WB1 = Workbooks(WB1N) 'من ملف
Set WB2 = Workbooks(WB2N) 'الى ملف
Set WB3 = Workbooks(WB3N) 'ملف البيانات
Set OSH = WB3.Sheets(ORDERSHET)
Set TS = WB2.Sheets(TSN) 'الى الورقة
ActiveSheet.Unprotect ' Password:=Range("PW")
TS.Unprotect 'Password:=WB2.Range("PW")
FDT = OSH.Range("K6").Value 'من تاريخ
TDT = OSH.Range("K7").Value 'الى تاريخ
DTC = OSH.Range("M9").Text 'عمود التاريخ لملف مصدر البيانات
FC1 = OSH.Range("K8").Text 'من العمود
FC2 = OSH.Range("M8").Text 'و العمود
TC = OSH.Range("L10").Text 'العمود الوجهة
TR = Val(OSH.Range("L11")) 'الصف الوجهة
'
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.EnableEvents = False
'
For SHN = 5 To 14
If OSH.Cells(SHN, 16) <> True Then GoTo 1
FSN = OSH.Cells(SHN, 8).Text
Set FS = WB1.Sheets(FSN)
ER = FS.UsedRange.Rows.Count + 11
For R = 1 To ER
QDT = FS.Range(DTC & R).Value
If QDT >= FDT And QDT <= TDT Then
CC2 = Val(Cells(1, FC1).Column) ' من عمود رقم
CC3 = Val(Cells(1, FC2).Column) ' الى عمود رقم
' التأكد من فراغ الصف الوجهة TR
7 For Each RN1 In Range(Cells(TR, CC2), Cells(TR, CC3))
    If RN1 <> "" Then
    TR = TR + 1
    GoTo 7
    End If
Next 'RN1
' نقل بيانات الصف
For CC = CC2 To CC3
TS.Cells(TR, CC) = FS.Cells(R, CC)
Next 'CC
TR = TR + 1
End If
Next 'R
1 Next 'SHN
OSH.Select
'Application.Run "Data_TransPorter01_Clear"
'Application.Run "protct"
Application.Calculation = xlAutomatic
Application.EnableEvents = True

البرنامج.xlsm

15 دقائق مضت, gamalin2 said:

الكود اعلاه يعمل جيدا ولكنه يعمل لسطرين فقط

لانك في سطرين فقط كاتب ok في العمود 14

و السطور الثانية لا يوجد بها اوكي

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

جرب هذا الموضوع

ان شاء الله تجد به ما تريد

https://www.officena.net/ib/topic/38355-مكتبة-الموقع-مُجمِع-البيانات-للاكسيل-excel-data-collector/

وهو للعلامه محمد طاهر

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

لست فاهم 

ممكن توضح اكثر

يعني هوه بعد تعبئة الجدول بيرحل الى ورقة ثالثة

اذا ممكن نضع الشرط مربوط ب الورقة الثالثة التي بها كل البيانات

صح

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

بالاضافة الى حل اخي الفاضل عبدالله جزاه الله خيرا

هذا حل آخر بطريقة اخرى

مع التحية

test01.xlsx

وهذا حل آخر

يارب يكون صحيح

الخطوات المتبعة

1

نقوم يتفكيك تاريخ البداية الى يوم و شهر وسنة - كل واحد في خانة

2

نحول التاريخ الميلادي لليوم الى تاريخ هجري

3

نفكك التاريخ الذي حولناه الى يوم و شهر وسنة - كل واحد في خانة

4

نبدء نحسب يوم ناقص يوم و شهر ناقص شهر و سنة ناقص سنة

كما في المرفق

وهكذا نفذت مني الحلول

hgry3.xlsx

مرفق

hgry2.xlsx

السلام عليكم

اخي الكريم

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

هو الدالة days360 و التي تقوم بحساب السنة على اساس 360 يوما = 30×12

مع التحية

الخلية N3 بها شرط اكتمال البيانات

=AND(G4<>"";K4<>"";D5<>"";K5<>"";D6<>"";K6<>"";D7<>"";K7<>"";D8<>"";B10<>"")

الخلية N4 تظهر بها اسماء البيانات الناقصة

=CONCAT(IF(G4="";E4&" -";"");IF(K4="";I4&" -";"");IF(D5="";B5&" -";"");IF(K5="";I5&" -";"");IF(D6="";B6&" -";"");IF(K6="";I6&" -";"");IF(D7="";B7&" -";"");IF(K7="";I7&" -";"");IF(B10="";H9&" -";""))

الخلية N5 بها نص الرسالة

=IF(N3;"";CONCAT("اكمل ادخال البيانات الناقصة";CHAR(10);CHAR(10);N4))

تم اضافة الى الكود مع الترحيل

If FS.Range("N3") = False Then
Dim Q1
Q1 = FS.Range("N5").Text
MsgBox Q1, vbMsgBoxRight, "خطاء"
Exit Sub
End If

مع التحية

y02.xlsm