DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub ONAY_KUTULARINI_HÜCRELERLE_İLİŞKİLENDİR()
Dim Onay_Kutusu As Shape, Satır As Long
On Error Resume Next
If ActiveSheet.Shapes.Count = 0 Then GoTo Son
For Each Onay_Kutusu In ActiveSheet.Shapes
Satır = Satır + 1
Onay_Kutusu.ControlFormat.LinkedCell = Cells(Satır, 2).Address
Call aktar
Next
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
Exit Sub
Son:
MsgBox "Onay kutusu bulunamamıştır.", vbExclamation
End Sub
Sub aktar()
Dim Satır As Long
Satır = Range("B65536").End(3).Row
If Cells(1, Satır).Value = "DOĞRU" Then
Sayfa2.Select
Cells(Satır, 2).Copy
End If
End Sub