المساعدة بخصوص ترحيل البيانات

[ahmed s metwally]

السلام عليكم

الاخوة الكرام احترت في عمل الكود ده

المطلوب داخل الملف 
واعتذر منكم وشكرا جزيلا

TEST.xlsx

[سليم حاصبيا]

جرب هذا الكود

Option Explicit
Sub copy_data()
Dim my_rg As Range
Dim col#, x#

Set my_rg = Sheets("sheet1").Range("b2", Range("b3").End(4))

col = Sheet2.Rows(2).Find(vbNullString, after:=Cells(2, Columns.Count) _
, SearchDirection:=1).Column
If col > 1 Then
 x = Application.CountIf(Sheet2.Rows(2), "<>" & "") * 2 - 1
 col = Sheet2.Rows(2).Find(vbNullString, after:=Cells(2, x), _
 SearchDirection:=1).Column + 1
End If

Sheet2.Cells(2, col).Resize(my_rg.Rows.Count, 1).Value = my_rg.Value
End Sub

الملف مرفق

 

salim_test.xlsm

[ahmed s metwally]

استاذي العزيز مش عارف اشكرك ازاي 
بجد ريحتني كتير 

شكرا جزيلا لك