استخراج بيانات في نفس الصفحه باستخدام VBA

[عمرو عبد الحليم]

ارجو المساعده في ايجاد كود VBA لاستخراج بيانات في نفس الشيت بدل استخدام الدوال وشكرا

كود VBA لايجد البيانات في المنطقه الصفراء.rar

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

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

انسخ هذا الكود والصقه فى موديول جديد وخصص له زر

واحفظ الملف باصدار 2003  او اعلى

Sub Ser_Data()
Dim R As Long, S As Integer, x As Variant
Range("I1:K" & Range("H" & Rows.Count).End(xlUp).Row).ClearContents
For R = 1 To Range("H" & Rows.Count).End(xlUp).Row
For S = 2 To 4
x = WorksheetFunction.VLookup(Cells(R, "H"), _
Range("B1:E" & Range("B" & Rows.Count).End(xlUp).Row), S, 0)
Cells(R, S + 7) = x
Next
Next
End Sub

 

[عمرو عبد الحليم]

9 دقائق مضت, زيزو العجوز said:

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

انسخ هذا الكود والصقه فى موديول جديد وخصص له زر

واحفظ الملف باصدار 2003  او اعلى

Sub Ser_Data()
Dim R As Long, S As Integer, x As Variant
Range("I1:K" & Range("H" & Rows.Count).End(xlUp).Row).ClearContents
For R = 1 To Range("H" & Rows.Count).End(xlUp).Row
For S = 2 To 4
x = WorksheetFunction.VLookup(Cells(R, "H"), _
Range("B1:E" & Range("B" & Rows.Count).End(xlUp).Row), S, 0)
Cells(R, S + 7) = x
Next
Next
End Sub

 

شكرا لك استاذ زيزو على الرد لكن الا يوجد كود لتكون بدون زر وشكرا

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

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

ضف العبارة الاولى الى الكود السابق بعد السطر الرابع

ثم انسخ الكود الذى يليها وضعه فى حدث الورقة الاولى

On Error Resume Next
---------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 8 Then Exit Sub
Call Ser_Data
End Sub

 

تم تعديل يناير 19, 2017 بواسطه زيزو العجوز

[عمرو عبد الحليم]

شكرا لك استاذ زيزو على الرد لكن يعطينى  

 فما الحل THIS COMMAND WILL STOP DEBUGGER

[عمرو عبد الحليم]

شكرا لك استاذ زيزو على المساعده وارجو منك المساعده في كارت الصنف وشكرا