ترحيل البيانات

[alfahad]

الاخوة الافاضل

احتاج الى كود ترحيل بشرط الاشهر

بمعنى انني احدد التاريخ من ( ) الى ( )

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

وشكرا

مرفق الملف الرجاء العمل عليه .

عفواً لم استطع تحميل الملف الظاهر انه يوجد مشكلة في المنتدى

الاشهر ترحيل.rar

الاشهر ترحيل.rar

الاشهر ترحيل.rar

الاشهر ترحيل.rar

الاشهر ترحيل.rar

الاشهر ترحيل.rar

[حسام السوري]

السلام عليكم ... هذه محاولة مني ..

Sub Button2_Click()

Dim LastRow

LastRow = Sheets(2).Cells(Sheets(2).Rows.Count, "B").End(xlUp).Row

Dim theSelection As Range

Set theSelection = Selection

If theSelection.Columns.Count <> 9 Then

MsgBox "please select 9 columns "

Exit Sub

End If

Dim usr_Date1 As Date

Dim usr_Date2 As Date

Dim TheString As String, FromDate, ToDate As Date


TheString = Application.InputBox("Enter the date1:")

If IsDate(TheString) Then

	 FromDate = DateValue(TheString)

Else

	 MsgBox "Invalid date"

	 Exit Sub

End If



TheString = Application.InputBox("Enter the date2:")

If IsDate(TheString) Then

	 ToDate = DateValue(TheString)

Else

	 MsgBox "Invalid date"

	 Exit Sub

End If



For i = 1 To theSelection.Rows.Count

'MsgBox theSelection.Cells(i, 4)

If theSelection.Cells(i, 4) <> "" And theSelection.Cells(i, 4).Value >= FromDate And theSelection.Cells(i, 4).Value <= ToDate Then

'MsgBox "ok"

LastRow = LastRow + 1

' Sheets(2).Cells(LastRow, 1) = theSelection.Cells(i, 1)

Sheets(2).Cells(LastRow, 2).Value = theSelection.Cells(i, 2).Value

Sheets(2).Cells(LastRow, 3) = theSelection.Cells(i, 3)

Sheets(2).Cells(LastRow, 4) = theSelection.Cells(i, 4)

Sheets(2).Cells(LastRow, 5) = theSelection.Cells(i, 5)

Sheets(2).Cells(LastRow, 6) = theSelection.Cells(i, 6)

Sheets(2).Cells(LastRow, 7) = theSelection.Cells(i, 7)

Sheets(2).Cells(LastRow, 8) = theSelection.Cells(i, 8)

Sheets(2).Cells(LastRow, 9) = theSelection.Cells(i, 9)

End If

Next

End Sub

الاشهر ترحيل.rar

تم تعديل سبتمبر 14, 2012 بواسطه حسام السوري

[alfahad]

جزاك الله خيراً اخي حسام

اريد ان اوضح انه تكمن مشكلة عندما ادخل التاريخ

من 1/1/1434 الى 30/1/1434

ينقل فقط الخلايا التي بها التاريخ 1/1/1434 فقط

[جمال عبد السميع]

أليك أخي وكل أماني أن يكون المطلوب

ترحيل بيانات.rar

[alfahad]

اخي الملف لا ينسخ

لا اعلم ما المشكلة ربما لم اعرف الطريقة الصحيحة للتعامل معه

ارجو التوضيح

[جمال عبد السميع]

ياأخي الملف ليس بالأكواد بل بالمعادلات أملأ بياناتك في شيت بيانات ثم إختار التاريخ ستقوم المعادلات بجلب البيانات المتعلقة بهذا التاريخ وهكذا أخي في شيت الأرسال وقد وضعت بعض البيانات العشوائية للتأكد من أن المعادلات تقوم بعملها جيدا

[alfahad]

اخي محمود

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

واليك المرفق للتاكد بنفسك

ترحيل بيانات11.rar

[يوسف عطا]

معادلاتك أكثر من ممتازة أخى محمود بك

وتدل على عبقرية وعلم ومقدرة على تطويع المعادلات لتحقيق الأهداف

أتمنى لك التوفيق

[جمال عبد السميع]

أستاذي ومعلمي ( يوسف عطا ) هذا بكثير علية أستاذي وأكثر مما أستحق ولكن لو سلمت جدلا بمدح أستاذي فسيكون له الفضل بعد الله عز وجل لأني تعلمت منكم وما تعلمتة منكم أعطية علي قدر فهمي جعل الله تشجيعك هذا في ميزان حسناتك وهذا تواضع العلماء

[أبو حنــــين]

بعد إذن الاخوة الكرام

اخي فهد جرب المرفق

الاشهر ترحيل.rar

[alfahad]

بعد شكرك اخي ابا حنين

ارجو منك الاطلاع على المرفق

سوف تجد خانات فارغة ولا اعلم ماهو الحل

وتقبل شكري،،،

الاشهر ترحيل ابو حنين.rar

[أبو حنــــين]

اخي فهد جرب المرفق و اخبرني بالنتيجة

ترحيل.rar

[جمال عبد السميع]

علي فكرة أخي لقد قمت بحذف جميع المعادلات من الشيتين لذلك لم يقم بجلب أية بيانات

أليك المرفق بعد |إعادة المعادلات للشيت

تم تعديل المرفق وتغيير المعادلة لتكون أدق في جلب البيانات

ترحيل.rar

[alfahad]

ليس المطلوب حيث ان ما اريد هو النسخ من تاريخ ( ) الى تاريخ ( ) كافة البيانات التي تقع بين التاريخين المحددين

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

واقدر لك ذلك

مع تمنياتي لك بالتوفيق

[أبو حنــــين]

اخي فهد هل جربت المشاركة رقم 12

[alfahad]

اخي ابو حنين

لله درك.. كما اردت

حفظك المولى وزادك علماً وتقاً

وقد لاحظت ان عدد الاسطر لا يتجاوز 45

فلو اردت زيادتها فما هو التعديل المطلوب لذلك

[أبو حنــــين]

غير الكود السابق بالكود التالي :

Dim i As Integer, x As Integer

Range("B7:T500").ClearContents

x = 7

For i = 1 To 500

    With ورقة1

If .Cells(i + 4, 21) >= Range("D1").Value And _

   .Cells(i + 4, 21) <= Range("L1").Value Then

	    ورقة1.Range("a" & i + 4).Resize(1, 19).Copy

	    Range("B" & x).PasteSpecial xlPasteValues

	    x = x + 1

	    End If: End With: Next

حيث انني وضع 500 و بامكانك استعمال عدد اكبر حسب صفحة البيانات

جرب و اخبرني

[alfahad]

اخي ابو حنين تم تجربة الكود ويتوقف عند السطر 45 اي لا ينسخ السطر 46

[أبو حنــــين]

هل غيرت نطاق التاريخ الاول و الثاني في الكمبوبكس

[أبو حنــــين]

اذهب الى صفحة البيانات و قم بالتالي ( طبعا هذا في الملف الذي ارسلته لك )

تجد في العمود U البرتقالي اللون ارقام ، هذه الارقام اكملها حتى 500

[alfahad]

اليك المرفق حيث قمت بالتغيير الى 500 ولم افلاح في النسخ

سوف اذهب لادى صلاة المغرب ثم اعود ان شاء الله

الاشهر ترحيل ابو حنين2.rar

[أبو حنــــين]

المشكلة كانت ايضا في المدى الخاص بالتاريخ

انظر صفحة الشرح

تقبل الله منكم الصلاة و لا تنسانا من دعائكم الصالح

الاشهر ترحيل ابو حنين2.rar

[alfahad]

تم والحمد لله

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

جزاك الله خيرا ورزقك الذرية الصالحة

[alfahad]

اخي ابا حنين

ياليت تشرح الكود لتعم الفائدة ونتعلم منك

ننتظر شرحكم