ترحيل من العمودي الى الافقي

[skyblue]

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

الاساتذة المشرفين والاعضاء الافاضل المحترمين

في الملف المرفق ارجوا المساعدة في الترحيل من االعمودي الى الافقي مع الاستمرار في الترحيل باستخدام باستخدام NEXT

تحياتي

ترحيل من العمودي الى الافقي.rar

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

السلام عليكم

استبدل الكود السابق بهذا

Sub trheel1()

Application.ScreenUpdating = False

Sheets("1").Cells(Sheets("1").[B1500].End(xlUp).Row + 1, 2) = Cells(4, 3)

For R = 5 To 9

Sheets("1").Cells(Sheets("1").[B1500].End(xlUp).Row, R - 2) = Cells(R, 3)

Next R

MsgBox "تم ترحيل البيانات بنجاح", vbInformation, "تم الترحيل"

End Sub

[الـعيدروس]

السلام عليكم

لتعدد الحلول

بطريقة الماكرو اللصق الخاص

Sub Ali_TR()

Application.ScreenUpdating = 0

Range(Cells(4, 3), Cells(9, 3)).Copy

Sheets(2).Range("B3:B" & Sheets(2).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row).PasteSpecial Transpose:=True

Application.CutCopyMode = 0

Application.ScreenUpdating = 1

End Sub

[بن علية حاجي]

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

أخي الكريم، دائما لتعدد الحلول هذا كود آخر يمكن استعماله:

Sub trheel2()

R = Sheets("1").[B1500].End(xlUp).Row + 1

Table = Sheets("ورقة1").Range("C4:C9").Value

Sheets("1").Cells(R, 2).Resize(1, UBound(Table)) = Application.WorksheetFunction.Transpose(Table)

MsgBox "تم ترحيل البيانات بنجاح", vbInformation, "حالة الترحيل"

End Sub

أخوك بن علية