Column=2 olan kısımdaki kodlar ayarlandı.
Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ws As Worksheet
' E?er t?klanan hücre A sütunundaysa
If Target.Column = 1 Then
' Belirtilen sayfa ad?na sahip bir sayfa var m? kontrol et
On Error Resume Next
Set ws = Sheets(Target.Value)
On Error GoTo 0
' Sayfa varsa ilgili sayfaya git
If Not ws Is Nothing Then ws.Select
End If
If Target.Column = 2 Then
Dim son As Integer, bul As Range
On Error Resume Next
Set ws = Sheets(Range("A" & Target.Row).Value)
On Error GoTo 0
Range("D2:F" & Rows.Count).Borders.LineStyle = xlNone
Range("D2:F" & Cells(Rows.Count, "D").End(3).Row + 3).ClearContents
Set bul = ws.Cells.Find(Target.Value2, , , , 1)
If Not bul Is Nothing Then
If WorksheetFunction.CountA(ws.Range(ws.Cells(bul.Row, bul.Column), ws.Cells(Rows.Count, bul.Column))) = 0 Then GoTo SonSub
son = ws.Cells(Rows.Count, bul.Column).End(3).Row
ws.Range(bul.Address, ws.Cells(son, bul.Column + 2)).Copy
Range("D2").PasteSpecial xlPasteValuesAndNumberFormats
Range("D3", Cells(Cells(Rows.Count, "D").End(3).Row, "F")).Borders.LineStyle = 1
Application.CutCopyMode = False
Columns("D:F").Columns.AutoFit
Range("D1").Select
End If
SonSub:
Set bul = Nothing
End If
End Sub
