سوال پیرامون هایپر لینک

[علی فاطمی]

با سلام خدمت اسایتد و کاربران محترم

در Book1 از سلول A1 تا A10 به ترتیب حروف a تا J قرار داده شده و تمامی این سلول ها به Book2 شیت 1 و سلول A1 هایپر لینک شده اند.
حال آیا این امکان وجود دارد زمانی که بر روی هر یک از این سلول ها کلیک شد ، ضمن باز شدن Book2 مجتویات همان سلول را در Book2 شیت 1 و سلول A1 کپی شود یعنی اگر A1 کلیک شد حرف a و اگر A10 کلیک شد حرف J در Book2 شیت 1 و سلول A1 کپی شود .

ممنون از توجه عزیزان

[علی فاطمی]

[علی فاطمی]

[iranweld]

با سلام

دو فایل پیوست را در یک مسیر کپی نمایید و book1.xlsx را اجرا نمایید

از قابلیت Event در تهیه فایل استفاده گردید

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Me.Range("A1:A10")) Is Nothing Then

If Range("B1").Value = "yes" Then
    
    TEST1
    
    Else
    
    End If
    End If
    
End Sub 

ماکرویی که فراخوانی میگردد

Public x As Variant

Sub TEST1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

x = ActiveCell.Value

Workbooks.Open fileName:=directory & "BOOK2.XLSX"

Sheets(1).Select

Range("A1").Select

Range("A1").Value = x

   

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub 

[علی فاطمی]

با سلام

دو فایل پیوست را در یک مسیر کپی نمایید و book1.xlsx را اجرا نمایید

از قابلیت Event در تهیه فایل استفاده گردید

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Me.Range("A1:A10")) Is Nothing Then

If Range("B1").Value = "yes" Then
    
    TEST1
    
    Else
    
    End If
    End If
    
End Sub 

ماکرویی که فراخوانی میگردد

Public x As Variant

Sub TEST1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

x = ActiveCell.Value

Workbooks.Open fileName:=directory & "BOOK2.XLSX"

Sheets(1).Select

Range("A1").Select

Range("A1").Value = x

   

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub 

با سلام و تشکر از دوست عزیز iranweld
لطفا فایل زیپ پیوست رو باز بفرمایید در فایل word توضیحاتی داده شده است.
ممنون از توجه شما.

[iranweld]

با سلام

در ماکرو فایل دوم چند سطر اول را بصورت ذیل تغییر بدید. در حالت فعلی ماکرو شما کل 100000 سلول ستون A را چک مینماید ولی با تغییر به شکل ذیل فقط چند ردیف سلول پر ستون A چک میگردد

Sub Resid()

Dim a

Dim zz As Range

k = Cells(Rows.Count, "A").End(xlUp).Row

For Each zz In Sheet3.Range("a4:a" & k)

If Sheet2.Range("a1") = zz Then