(تمت الإجابة) شرح كود ترحيل بيانات من شيت الي شيت آخر

[عبد العزيز كمال]

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

طلب بسيط جدا ارجو الرد

اريد شرح لهذا الكود

Sub OFFICNA1()

LR = Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Row

x = Range("F2").Value

Range("A2:D" & LR).Select

Selection.Copy

Range("A2").Select

Sheets(x).Select

LR1 = Sheets(x).Range("a" & Rows.Count).End(xlUp).Row

Range("A" & LR1 + 1).Select

ActiveSheet.Paste

Application.CutCopyMode = False

Range("C1").Select

MsgBox ("done")

End Sub

انا فهمت بعض خطواتة الخطوات اااساسية اللي هي في السطور الطويلة مش فاهمها

[عبدالله المجرب]

اخي الفاضل

هذا الجزء لتحديد رقم اخر صف يحتوي على بيانات في العمود a من الورقة Sheet1

LR = Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Row

هذا يعني ان X تساوي قيمة الخلية F2

x = Range("F2").Value

يتم إختيار المدى A2 الى D ورقم اخر صف ثم يتم نسخ المضلل ثم ازالة التحديد عن المدى

Range("A2:D" & LR).Select

Selection.Copy

Range("A2").Select

إختيار ورقة العمل التي اسمها في الخلية F2

Sheets(x).Select

هذا الجزء لتحديد رقم اخر صف يحتوي على بيانات في العمود a من الورقة التي اسمها في الخلية F2

LR1 = Sheets(x).Range("a" & Rows.Count).End(xlUp).Row

اخيار المدى A و رقم اخر صف +1 ولصق البيانات فيه

Range("A" & LR1 + 1).Select

ActiveSheet.Paste

إلغاء وضع النسخ واللصق واختيار الخلية C1 وظهور رسالة بكلمة done

Application.CutCopyMode = False

Range("C1").Select

MsgBox ("done")

ان شاء الله الشرح وافي

ابواحمد

[saad abed]

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

[عبدالله المجرب]

شكراً لك اخي سعد

ارجو منك الانتباه اثناء كتابة كلمة ان شاء الله

ابواحمد

تم تعديل أكتوبر 1, 2011 بواسطه عبدالله المجرب

[عبد العزيز كمال]

الله يكرمك شكرا تمام

[3mr 3bdeen]

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

[الصـقر]

جزاك الله كل الخير .. عندى مشكله اعمل كود ترجيل بيانات من شيت الى اخر فى البدايه يكون صحيح وبعد يوم او اثنين بدون اى تعديل على الكود ليعطى نتيجه ترحيل خلايا خطا - ارجو الافاده وجزاكم الله خير

Sub trheel2()

If Range("G4") <> ("H4") = 1 Then

MsgBox "ãÌãæÚ ÇáãÏíä áÇ íÓÇæì ÇáÏÇÆä"

Else

Dim LR As Integer

LR = [c1000].End(xlUp).Row

Range("A6:i" & LR).Copy

Sheets("ÚÇã").Range("B" & Sheets("ÚÇã").[b10000].End(xlUp).Row + 1).PasteSpecial xlPasteValues

Application.CutCopyMode = False

Range("C6:H" & LR).ClearContents

MsgBox "Êã ÇáÊÑÍíá ÈäÌÇÍ", vbOKOnly, "ÊäÈíÉ"

End If

End Sub

تم تعديل أبريل 27, 2014 بواسطه حسام عيسى

[إبراهيم ابوليله]

اخى عبدالله

الكبير كبير

شرح وافى ومتقن

بارك الله فيك