çoklu hücre seçme

[escape43]

Private Sub Workbook_Open()
For i = 1 To 500
If Cells(i, 12).Value = Cells(1, 8).Value Then

Cells(i, 12).Select
Dim a As Integer
a = ActiveCell.Row
Dim b As String
b = Range("b4").Value
MsgBox "KURUYA AYRILACAK HAYVAN ADI: " & b
End If
Next

End Sub

sizlere göre basittir mutlaka ama uğraştım bitürlü yapamadım. yukarıda ki kodlarda renkli olan kodda sadece b4 hücresini değilde b sütunundaki hangi hücrede değişiklik varsa onu yazmasını istiyorum bunu nasıl yapabilirim.
yardımlarınız için çok teşekkür

 

[Husgvarna]

Aşağıdaki gibi deneyin olmazsa bir örnek ekleyin.

Private Sub Workbook_Open()
Dim b As String
For i = 1 To 500
If Cells(i, 12).Value <> "" Then
If Cells(i, 12).Value = Cells(1, 8).Value Then
b = Range("b" & i).Value
MsgBox "KURUYA AYRILACAK HAYVAN ADI: " & b
End If
End If
Next
End Sub

 

[escape43]

Aşağıdaki gibi deneyin olmazsa bir örnek ekleyin.

Private Sub Workbook_Open()
Dim b As String
For i = 1 To 500
If Cells(i, 12).Value <> "" Then
If Cells(i, 12).Value = Cells(1, 8).Value Then
b = Range("b" & i).Value
MsgBox "KURUYA AYRILACAK HAYVAN ADI: " & b
End If
End If
Next
End Sub

Çok teşekkür ederim sizlerin gibi ustalar olmasa inanın işimiz baya zor.
Bi sorum daha olacaktı ekteki dosyada B ve C sütünlarındaki isim ve kulak numaralarını userform da girerken kulak numarasını ve adını girdiğim hayvanın mükerrer giriş yapılmaya çalışıldığında uyarı vermesini ve kayıt yapmamasını istiyorum bunu nasıl yapabilirim. ilgin için çok teşekkür ederim

 

[Husgvarna]

"CommandButton1" deki kodlarınıza aşağıdaki kırmızı bölümü ekleyerek deneyin.

 Private Sub CommandButton1_Click()
If TextBox1.Text <> "" Then
 If TextBox2.Text <> "" Then
  If TextBox3.Text <> "" Then
   If TextBox4.Text <> "" Then
    If TextBox5.Text <> "" Then
    
  [COLOR="Red"]    Set c = Range("b1:b65000").Find(TextBox1.Value)
If Not c Is Nothing Then
Adres = c.Address
Do
If Range("c" & c.Row).Text = TextBox2.Text Then
MsgBox "Bu hayvan zaten kayıttlı"
Exit Sub
End If
Set c = Range("b1:b65000").FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adres
End If[/COLOR]
    
Son_Dolu_Satir = Sheets("Data").Range("A65536").End(xlUp).Row
    Bos_Satir = Son_Dolu_Satir + 1
     Sheets("Data").Range("A" & Bos_Satir).Value = _
                   Application.WorksheetFunction.Max(Sheets("Data").Range("A:A")) + 1
 
    Sheets("Data").Range("B" & Bos_Satir).Value = TextBox1.Text

Kulak numarası ile ilgili bir ayrıntıyı atlamışım değiştirdim.

 

[escape43]

Çok teşekkür ederim Allah Razı olsun makbule geçti