Olá Pessoa bom dia, Sou novo aqui no fórum e pesquisando aqui não consegui encontrar o que realmente eu preciso. Estou criando um aplicativo para controle reprodutivo de vacas de leite. Tenho um listview que carrega os dados que eu preciso modificar. Até ai beleza.

Fiz uma rotina que quando eu marco o checkbox do listiview, ele altera 4 celulas na planilha colocando valores específicos. A duvida é o seguinte: quando eu marco um checkbox ele executa o código certinho,porem quando eu marco mais de um checkbox ele só executa no ultimo item marcado. Como que eu faço para que ele mude todos os itens marcados?

Segue o código que uso para a fazer as alterações
Private Sub Bt_Diagnosticar_Click()
If Me.Data_diagnóstico.Text = Empty Then
MsgBox "É necessário adicionar uma data.", vbCritical, "Diagnóstico de gestação."
Data_diagnóstico = GetCalendário
Exit Sub
ElseIf Me.Data_diagnóstico.Text > Date Then
MsgBox "Data futura não permitido.", vbCritical, "Diagnóstico de gestação."
Data_diagnóstico = GetCalendário
Exit Sub
End If

For x = 1 To Me.ListView1.ListItems.Count
If Me.ListView1.ListItems.Item(x).Checked Then
Dim intervalo As Date
intervalo = 30
If Me.ListView1.ListItems.Item(x).Checked = True Then
For Y = 1 To Me.ListView1.ListItems.Count
Dim soma As Integer
For i = 1 To ListView1.ListItems.Count
If ListView1.ListItems.Item(i).Checked = True Then
soma = soma + 1
End If
Next i
If MsgBox("Deseja lançar o diagnóstico positivo para : " & soma & " vaca(s).", vbYesNo + vbInformation, "Diagnóstico de gestação") = vbYes Then
'Lançar positivo na planilha =======================================================================================
Dim linha As Integer
Dim data As Date

linha = 1
For diag = 1 To ListView1.ListItems.Count
If ListView1.ListItems(diag).Selected = True Then
Range("A1").Select
Do While ActiveCell.Value <> ""
If ActiveCell.Value = ListView1.ListItems(diag) Then
ActiveCell.Cells(linha, 9) = "Sim"
ActiveCell.Cells(linha, 8) = Me.Data_diagnóstico.Text
' ActiveCell.Cells(linha, 12) = Me.Data_diagnóstico.Text - ActiveCell.Cells(linha, 3)
End If
ActiveCell.Offset(1, 0).Select
Loop
End If
Next diag
'======================================================================================
MsgBox "Diagnóstico positivo lançado com sucesso para: " & soma & " vaca(s).", vbInformation, "Diagnóstico de gestação"
Label1.Caption = ""
Me.Bt_Diagnosticar.Enabled = False
Call preenche_listiview
Else
Exit Sub
End If
Exit Sub
Next Y
End If
Exit Sub
End If
Next x
MsgBox "Selecione pelo menos um animal.", vbInformation, "Diagnóstico de gestação"
Plan4.Range("a1").Select
Me.CheckBox1.Cancel = True
End Sub

O que não está dando certo certo são as linhas de cor vermelho

Desde já Agradeço