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

[حسين احمد مانع]

السلام عليكم ارغب بترحيل البيانات الملونه بالرمادي الى الداتا مفرقه الى سطر واحد ولكم كل الشكر والتقدير

TEST.xlsm

[ابراهيم الحداد]

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

استخدم هذا الكود

Sub Transfer()
Dim ws As Worksheet, Sh As Worksheet
Dim Arr As Variant
Set ws = Sheets("vi")
Set Sh = Sheets("DATA")
Arr = Array(ws.Range("B3"), ws.Range("C7"), ws.Range("A6"))
Sh.Range("B4").Resize(, 3) = Arr
End Sub

 

[حسين احمد مانع]

ربي يسعدك ويحفظك

ممكن لو اضيف جديد يضاف تحت القديم بسطر جديد

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

[ابراهيم الحداد]

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

استخدم الكود التالى بدلا من الكود السابق

Sub Transfer()
Dim ws As Worksheet, Sh As Worksheet
Dim Arr As Variant, LR As Long
Set ws = Sheets("vi")
Set Sh = Sheets("DATA")
LR = Sh.Range("B" & Rows.Count).End(3).Row + 1
Arr = Array(ws.Range("B3"), ws.Range("C7"), ws.Range("A6"))
Sh.Range("B" & LR).Resize(, 3) = Arr
End Sub

 

[حسين احمد مانع]

وعليكم السلام استاذي الغالي

 

مشكور وان شاء الله في ميزان حسناتك