كود لنقل بيانات

[الشيباني1]

اخواني الاعزاء تحية طيبه ارجو المساعده فيما جاء بالمرفق مع الامتنان

كود نقل بيانات.zip

[الشيباني1]

اخواني الاعزاء مع تقديري واحترامي هل من حل للموضوع مع الشكر

[الـعيدروس]

السلام عليكم

تفضل جرب هذا الكود

Public Rn() As Variant

Public Sub Ali()

Dim Ali_Ro&, Ali_Co&

Dim T%, E%, CC%

Ali_Co = 5

Ali_Ro = Cells(Rows.Count, 2).End(xlUp).Row

With Range("B5").Resize(Ali_Ro, Ali_Co)

ReDim Rn(1 To Ali_Ro, 1 To Ali_Co)

For T = 1 To .Rows.Count

If CStr(.Cells(T, 1)) <> "" Then

E = E + 1

For CC = 1 To Ali_Co

Rn(E, CC) = CStr(.Cells(T, CC))

Next

End If

Next

End With

Range("B5").Resize(Ali_Ro, Ali_Co).ClearContents

Range("B5").Resize(Ali_Ro, Ali_Co).Value = Rn

Erase Rn

End Sub

Ali_Sert.rar

تم تعديل أكتوبر 25, 2012 بواسطه عباد

[الشيباني1]

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