استدعاء بيانات من شيت الى اخر عند كتابة الاسم

hitech · سبتمبر 24, 2019

السلام عليكم

عاوز يا جماعة استدعى البيانات من ورقة 2 الى ورقة 1 بمعنى لما اكتب اسم محمد فى ورقة 1 يتم استدعاء بياناته وهكذا

**سليم حاصبيا** · سبتمبر 24, 2019

جرب هذا الماكرو

الاسم المطلوب في الخلية A1

تم تغيير اسماء الشيتات الى source_sh و target_sh لحسن عملية نسخ الكود ونقله بحيث لا تظهر حروف غريبة

Sub Find_Recorde()
Rem Created By Salim Hasbaya On 24/9/2019
Dim S As Worksheet: Set S = Sheets("source_sh")
Dim T As Worksheet: Set T = Sheets("target_sh")
Dim Nam: Nam = T.Cells(1, 1)
Dim My_RG As Range
Dim Saerch_Rg As Range
T.Cells(3, 1).CurrentRegion.Clear
Dim col%, Ro%, Actual_ro%
Set Saerch_Rg = S.Columns(5).Find(Nam, lookat:=1)
    If Saerch_Rg Is Nothing Then
        MsgBox _
        "This Name Dos not exit or Wrong Name"
        Exit Sub
    End If
Ro = Saerch_Rg.Row + 1
col = S.Cells(Ro, Columns.Count).End(1).Column
Actual_ro = S.Cells(Ro, 1).End(4).Row - Ro + 1
 With T.Cells(3, 1).Resize(Actual_ro, col)
    .Value = S.Cells(Ro, 1).Resize(Actual_ro, col).Value
    .Borders.LineStyle = 1
    .NumberFormat = "[$-,10A] ddd d  mmm yyyy"
    .Interior.ColorIndex = 24
    .Font.Bold = True
End With
End Sub

الملف مرفق

Record.xlsm