Sayfa aktif olduğunda verileri alma

[cember68]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim S3 As Worksheet, c As Range
Dim S4 As Worksheet

Set S3 = Sheets("2")
Set S4 = Sheets("Beton-defter")

On Error Resume Next

If Intersect(Target, [A:A]) Is Nothing Then Exit Sub

With Target
Set c = S3.[A:A].Find(.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
.Offset(0, 1) = S3.Range("B" & c.Row)
.Offset(0, 2) = S3.Range("C" & c.Row)
.Offset(0, 3) = S3.Range("D" & c.Row)
.Offset(0, 4) = S3.Range("E" & c.Row)
.Offset(0, 5) = S3.Range("G" & c.Row)
.Offset(0, 6) = S3.Range("H" & c.Row)
.Offset(0, 7) = S3.Range("I" & c.Row)
.Offset(0, 8) = S3.Range("J" & c.Row)

Else
Range("D" & .Row & ":F" & .Row).ClearContents
MsgBox "YİBF NO TALEP DOSYASINDA YOKTUR..."
End If
End With
End Sub



Herkese Merhaba...
Bu kod ile A sütununda bir hücreye tıkladığımda veri alabiliyorum.

Ben sayfa aktif olduğunda verileri almasını veya da herhangi bir hücreye tıkladığımda veri almasını istiyorum.
Nasıl olabilir.

 

[u.L.a.s]

Private Sub Worksheet_SelectionChange(ByVal Target As Range) kısmını aşağıdaki sub ile güncellerseniz. o sayfayı seçtiğiniz an bu makro çalışacaktır..

Private Sub Worksheet_Activate()

 

[cember68]

Private Sub Worksheet_SelectionChange(ByVal Target As Range) kısmını aşağıdaki sub ile güncellerseniz. o sayfayı seçtiğiniz an bu makro çalışacaktır..

Private Sub Worksheet_Activate()

Denedim fakat hiçbir bilgiyi almadı hocam.

If Intersect(Target, [A:A]) Is Nothing Then Exit Sub burada hata veriyor.

 

[u.L.a.s]

O zaman sub kısmını hiç değiştirmeden sayfa içerisinde hangi hücreye basarsanız basın bu makronun çalışması için aşağıdaki kodu uygulayınız

Burada verilerinizin Z sütununa kadar olabileceğini öngörerek aşağıdaki kodda A:A yerine A:Z yazdım. sayfa içerisinde a ve Z sütunları arasında hangi hücreye tıklarsanız makro çalışacaktır

If Intersect(Target, [A:Z]) Is Nothing Then Exit Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim S3 As Worksheet, c As Range
Dim S4 As Worksheet

Set S3 = Sheets("2")
Set S4 = Sheets("Beton-defter")

On Error Resume Next

If Intersect(Target, [A:Z]) Is Nothing Then Exit Sub

With Target
Set c = S3.[A:A].Find(.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
.Offset(0, 1) = S3.Range("B" & c.Row)
.Offset(0, 2) = S3.Range("C" & c.Row)
.Offset(0, 3) = S3.Range("D" & c.Row)
.Offset(0, 4) = S3.Range("E" & c.Row)
.Offset(0, 5) = S3.Range("G" & c.Row)
.Offset(0, 6) = S3.Range("H" & c.Row)
.Offset(0, 7) = S3.Range("I" & c.Row)
.Offset(0, 8) = S3.Range("J" & c.Row)

Else
Range("D" & .Row & ":F" & .Row).ClearContents
MsgBox "YİBF NO TALEP DOSYASINDA YOKTUR..."
End If
End With
End Sub

 

[cember68]

O zaman sub kısmını hiç değiştirmeden sayfa içerisinde hangi hücreye basarsanız basın bu makronun çalışması için aşağıdaki kodu uygulayınız

Burada verilerinizin Z sütununa kadar olabileceğini öngörerek aşağıdaki kodda A:A yerine A:Z yazdım. sayfa içerisinde a ve Z sütunları arasında hangi hücreye tıklarsanız makro çalışacaktır

If Intersect(Target, [A:Z]) Is Nothing Then Exit Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim S3 As Worksheet, c As Range
Dim S4 As Worksheet

Set S3 = Sheets("2")
Set S4 = Sheets("Beton-defter")

On Error Resume Next

If Intersect(Target, [A:Z]) Is Nothing Then Exit Sub

With Target
Set c = S3.[A:A].Find(.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
.Offset(0, 1) = S3.Range("B" & c.Row)
.Offset(0, 2) = S3.Range("C" & c.Row)
.Offset(0, 3) = S3.Range("D" & c.Row)
.Offset(0, 4) = S3.Range("E" & c.Row)
.Offset(0, 5) = S3.Range("G" & c.Row)
.Offset(0, 6) = S3.Range("H" & c.Row)
.Offset(0, 7) = S3.Range("I" & c.Row)
.Offset(0, 8) = S3.Range("J" & c.Row)

Else
Range("D" & .Row & ":F" & .Row).ClearContents
MsgBox "YİBF NO TALEP DOSYASINDA YOKTUR..."
End If
End With
End Sub

Hocam yordum sizi ama yine sadece A sütunundaki hücrelere basıldığında veri alıyor.

 

[cember68]

Yardım edebilecek arkadaş var mı???