المطلوب تعديل كود ترحيل البيانات

[احمد شيخ الشباب]

Dim sh As Worksheet

Dim ws As Worksheet

Set sh = Sheets("LIST")

Set ws = Sheets("sheet1")

    ws.Range("A1").Value = sh.Range("A1").Value

    ws.Range("B1").Value = sh.Range("B1").Value

    ws.Range("C1").Value = sh.Range("C1").Value

    ws.Range("D1").Value = sh.Range("D1").Value

End Sub

 

 

بسم الله الرحمن الرحيم

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

اريد تعديل على الكود بحيث كل صفحة بعد الأخرى ترحل لها الصفوف بالترتيب

مثلا الصفحة 2 يرحل لها بيانات الصف 2

والصفحة 3 يرحل لها بيانات الصف3

وهكذا>>>>>>>>>>>>>>>>>>>>>>>>>>>

[ياسر خليل أبو البراء]

أخي الفاضل

ارفق مثال للتوضيح وللعمل عليه

[احمد شيخ الشباب]

أخي الفاضل

ارفق مثال للتوضيح وللعمل عليه

تم ارفاق ملف

شكرا على الاهتمام اخي ياسر

اوفيسنا.rar

[ياسر خليل أبو البراء]

أخي الكريم أحمد

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

جرب الكود التالي

Sub JJJ()
    Dim WS As Worksheet, SH As Worksheet
    Dim I As Long, strSH As String
    Set WS = Sheets("LIST")
    
    Application.ScreenUpdating = False
    For I = 2 To 22
        strSH = "sheet" & I - 1
        Sheets(strSH).Range("A15:F16").ClearContents
        Sheets(strSH).Range("F15").Value = WS.Cells(I, 1).Value
        Sheets(strSH).Range("E15").Value = WS.Cells(I, 2).Value
        Sheets(strSH).Range("D15").Value = WS.Cells(I, 3).Value
        Sheets(strSH).Range("C15").Value = WS.Cells(I, 4).Value
        Sheets(strSH).Range("B15").Value = WS.Cells(I, 5).Value
        Sheets(strSH).Range("A15").Value = WS.Cells(I, 6).Value
    Next I
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

Transfer Data To Sheets.rar

[احمد شيخ الشباب]

أخي الكريم أحمد

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

جرب الكود التالي

Sub JJJ()
    Dim WS As Worksheet, SH As Worksheet
    Dim I As Long, strSH As String
    Set WS = Sheets("LIST")
    
    Application.ScreenUpdating = False
    For I = 2 To 22
        strSH = "sheet" & I - 1
        Sheets(strSH).Range("A15:F16").ClearContents
        Sheets(strSH).Range("F15").Value = WS.Cells(I, 1).Value
        Sheets(strSH).Range("E15").Value = WS.Cells(I, 2).Value
        Sheets(strSH).Range("D15").Value = WS.Cells(I, 3).Value
        Sheets(strSH).Range("C15").Value = WS.Cells(I, 4).Value
        Sheets(strSH).Range("B15").Value = WS.Cells(I, 5).Value
        Sheets(strSH).Range("A15").Value = WS.Cells(I, 6).Value
    Next I
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

 

 

 

عن ابن عمر -رضي الله عنهما- عن النبي -صلى الله عليه وسلم- أنه قال: (من كان في حاجة أخيه كان الله في حاجته).

 أبي هريرة -رضي الله عنه- عن النبي -صلى الله عليه وسلم- أنه قال: (والله في عون العبد ما كان العبد في عون أخيه).

عن أبي هريرة -رضي الله عنه- أن رسول الله -صلى الله عليه وسلم- قال: إذا مات ابن آدم انقطع عمله إلا من ثلاث: صدقة جارية، أو علم ينتفع به، أو ولد صالح يدعو له، رواه مسلم

ارفقت هذه الاحاديث الثلاث لدلالة اجر من يعمل على مساعدة الناس واعطائهم من وقته وعلمه دون ابتغاء الاجر من الناس

 

الهم بلغنا رمضان واعنا على صيامه وقيامه

الهم فرج الفم والهم عنا وعن عبادك المستضعفين في سوريا وسائر بلاد المسليمن

 

وأخبر النبي صلى الله عليه وسلم عن استجابته لدعاء من دعا لأخيه، فقال : دعوة المرء المسلم لأخيه بظهر الغيب مستجابة، عند رأسه ملك موكل به، كلما دعا لأخيه قال الملك الموكل به: آمين ولك بمثل . رواه مسلم

 

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

[ياسر خليل أبو البراء]

جزيت خير الجزاء أخي الحبيب أحمد على كلماتك الطيبة ودعائك المبارك

تقبل الله منا ومنكم وبلغنا وإياكم شهر رمضان

 

مشكور على تحديدك أفضل إجابة لإنهاء الموضوع بالشكل اللائق .. دعوة لكل الأعضاء الذين يطرحون موضوعات الاقتداء بشيخ الشباب

تقبل تحياتي