TUNCA ERSİN
Altın Üye
- Katılım
- 18 Ağustos 2021
- Mesajlar
- 131
- Excel Vers. ve Dili
- Office Professional plus 2016 Tr
- Altın Üyelik Bitiş Tarihi
- 18-08-2026
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Pvt As PivotTable, Target_Source As String, Sh As Worksheet
Dim Rng As Range, Find_Header As Range, Find_Data As Range
If Intersect(Target, [A2:A10]) Is Nothing Then Exit Sub
On Error GoTo Son
Cells.Interior.ColorIndex = xlNone
Target.Resize(, 2).Interior.ColorIndex = 6
For Each Pvt In ActiveSheet.PivotTables
Target_Source = Application.ConvertFormula( _
Formula:=Pvt.SourceData, _
fromReferenceStyle:=xlR1C1, _
toReferenceStyle:=xlA1)
Set Sh = Sheets(Split(Split(Target_Source, "]")(1), "'!")(0))
Set Rng = Sh.Range(Split(Split(Target_Source, "]")(1), "'!")(1))
Set Find_Header = Rng.Rows(1).Find(Pvt.TableRange2.Cells(1, 1), , , xlWhole)
If Not Find_Header Is Nothing Then
Set Find_Data = Rng(, Find_Header.Column).Find(Pvt.TableRange2.Cells(1, 2), , , xlWhole)
If Not Find_Data Is Nothing Then
Select Case Pvt.TableRange2.Cells(1, 2).Address(0, 0)
Case "G1": Range("G1") = Target.Value
Case "L1": Range("L1") = Target.Value
Case "Q1": Range("Q1") = Target.Value
End Select
End If
End If
Pvt.RefreshTable
Next
Son:
End Sub