Elimde excel vba ile yazılmış bir kod var. Kod:
"
Sub AramaALL11()

   Dim ROTA_GRANUL As Worksheet
Dim ROTA_FBD As Worksheet
Dim ROTA_BASKI As Worksheet
Dim ROTA_KAPLAMA As Worksheet
Dim ROTA_AMBALAJ As Worksheet
Dim ONCELIK As Worksheet
Dim GRANULASYON As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim currentRow As Long
Dim currentCol As Long
Dim FoundCell As Range
Dim ArananDeger As Range
Dim ArananDegerG As Range
Dim ArananDegerH As Range
Dim ArananDegerI As Range
Dim ArananDegerJ As Range
Dim ArananDegerK As Range
Dim EslesenDeger As Range
Dim EslesenDegerG As Range
Dim EslesenDegerH As Range
Dim EslesenDegerI As Range
Dim EslesenDegerJ As Range
Dim EslesenDegerK As Range
Dim KontrolHucre As Range
Dim Granulsure1 As Variant
Dim Fbdsure1 As Variant
Dim Baskisure1 As Variant
Dim Kaplamasure1 As Variant
Dim Ambalajsure1 As Variant
Dim startColLetter As String
Dim startColIndex As Integer
Dim checkCol As Long
Dim numberOfCol As Long
Dim randomRed As Integer
Dim randomGreen As Integer
Dim randomBlue As Integer
Dim previousArananDeger As Variant
Dim firstCell As Range
Dim secondCell As Range

Set GRANULASYON = ThisWorkbook.Worksheets("GRANULASYON")
Set ROTA_GRANUL = ThisWorkbook.Worksheets("ROTA_GRANUL")
Set ROTA_FBD = ThisWorkbook.Worksheets("ROTA_FBD")
Set ROTA_BASKI = ThisWorkbook.Worksheets("ROTA_BASKI")
Set ROTA_KAPLAMA = ThisWorkbook.Worksheets("ROTA_KAPLAMA")
Set ROTA_AMBALAJ = ThisWorkbook.Worksheets("ROTA_AMBALAJ")
Set ONCELIK = ThisWorkbook.Worksheets("ONCELIK")
Set E2 = ONCELIK.Range("E2")
previousArananDeger = """"

For Each ArananDeger In ONCELIK.Range(E2, E2.End(xlDown))
If ArananDeger.Value <> previousArananDeger Then
Do
randomRed = Int(Rnd * 256)
randomGreen = Int(Rnd * 256)
randomBlue = Int(Rnd * 256)
Loop Until ((randomRed <> 0 Or randomGreen <> 0 Or randomBlue <> 0) And _
(randomRed <> 255 Or randomGreen <> 255 Or randomBlue <> 255) And _
(randomRed <> 255 Or randomGreen <> 0 Or randomBlue <> 0) And _
(randomRed <> 255 Or randomGreen <> 255 Or randomBlue <> 0))
previousArananDeger = ArananDeger.Value
End If

' ROTA_GRANUL sayfası için
Set EslesenDeger = ROTA_GRANUL.Range("E:E").Find(ArananDeger.Value)

If Not EslesenDeger Is Nothing Then

Set ArananDegerG = ONCELIK.Cells(ArananDeger.Row, "G")
Set EslesenDegerG = ROTA_GRANUL.Range("1:1").Find(ArananDegerG.Value)

If Not EslesenDegerG Is Nothing Then

Set KontrolHucre = ROTA_GRANUL.Cells(EslesenDeger.Row, EslesenDegerG.Column)

If Not IsEmpty(KontrolHucre) Then

Granulsure1 = KontrolHucre.Value ' Hücredeki değeri kaydedin

Else
MsgBox ArananDeger.Value & " ve ekipmanın süresi yok" ' Yeni mesajı göster
End If

Else
MsgBox ArananDeger.Value & " ürününde böyle bir ekipman yok" ' 4 mesajının yerine geçen yeni mesajı göster
End If

Else
Exit For ' If sorgusundan çıkmak için bu satırı kullanın
End If
startColLetter = Sheets("ONCELIK").Range("L2").Value
startColIndex = Range(startColLetter & 1).Column

Set FoundCell = GRANULASYON.Range("A5:A9").Find(What:=ArananDegerG, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not FoundCell Is Nothing Then
currentRow = FoundCell.Row
lastCol = -1
For checkCol = GRANULASYON.Columns.Count To startColIndex Step -1
If GRANULASYON.Cells(currentRow, checkCol).Interior.Color <> RGB(255, 255, 255) Then
lastCol = checkCol
Exit For
End If
Next checkCol

If lastCol <> -1 Then
For numberOfCol = 1 To Granulsure1
GRANULASYON.Cells(currentRow, lastCol + numberOfCol).Interior.Color = RGB(randomRed, randomGreen, randomBlue)
Next numberOfCol
' Yeni özellik: İlk hücreye C sütununun değerini yazın
GRANULASYON.Cells(currentRow, lastCol + 1).Value = ONCELIK.Cells(ArananDeger.Row, "C")

' Yeni özellik: Son hücreye F sütununun değerini yazın
GRANULASYON.Cells(currentRow, lastCol + Granulsure1).Value = ONCELIK.Cells(ArananDeger.Row, "F")

' Yeni özellik: Hücreleri birleştir
GRANULASYON.Range(GRANULASYON.Cells(currentRow, lastCol + 1), GRANULASYON.Cells(currentRow, lastCol + Granulsure1 - 1)).MergeCells = True

'Yeni özellik:Kenarlik
Set firstCell = GRANULASYON.Cells(currentRow, lastCol + 1)
Set secondCell = GRANULASYON.Cells(currentRow, lastCol + Granulsure1)
GRANULASYON.Range(firstCell, secondCell).Borders(xlEdgeTop).LineStyle = xlContinuous
GRANULASYON.Range(firstCell, secondCell).Borders(xlEdgeBottom).LineStyle = xlContinuous
GRANULASYON.Range(firstCell, secondCell).Borders(xlEdgeLeft).LineStyle = xlContinuous
GRANULASYON.Range(firstCell, secondCell).Borders(xlEdgeRight).LineStyle = xlContinuous

Else
' Renkli hücre bulunamadıysa başlangıç sütununda boyamaya başlayın
For numberOfCol = 1 To Granulsure1
GRANULASYON.Cells(currentRow, startColIndex + numberOfCol - 1).Interior.Color = RGB(randomRed, randomGreen, randomBlue)
Next numberOfCol
' Yeni özellik: İlk hücreye C sütununun değerini yazın
GRANULASYON.Cells(currentRow, startColIndex).Value = ONCELIK.Cells(ArananDeger.Row, "C")

' Yeni özellik: Son hücreye F sütununun değerini yazın
GRANULASYON.Cells(currentRow, startColIndex + Granulsure1 - 1).Value = ONCELIK.Cells(ArananDeger.Row, "F")

' Yeni özellik: Hücreleri birleştir
GRANULASYON.Range(GRANULASYON.Cells(currentRow, startColIndex), GRANULASYON.Cells(currentRow, startColIndex + Granulsure1 - 2)).MergeCells = True

' Yeni özellik: Kenarlik
Set firstCell = GRANULASYON.Cells(currentRow, startColIndex)
Set secondCell = GRANULASYON.Cells(currentRow, startColIndex + Granulsure1 - 1)
GRANULASYON.Range(firstCell, secondCell).Borders(xlEdgeTop).LineStyle = xlContinuous
GRANULASYON.Range(firstCell, secondCell).Borders(xlEdgeBottom).LineStyle = xlContinuous
GRANULASYON.Range(firstCell, secondCell).Borders(xlEdgeLeft).LineStyle = xlContinuous
GRANULASYON.Range(firstCell, secondCell).Borders(xlEdgeRight).LineStyle = xlContinuous

End If
Else
MsgBox ArananDegerG & " değeri bulunamadı."""
End If

        ' ROTA_FBD sayfası için
        Set EslesenDeger = ROTA_FBD.Range("E:E").Find(ArananDeger.Value)

        If Not EslesenDeger Is Nothing Then

            Set ArananDegerH = ONCELIK.Cells(ArananDeger.Row, "H")
            Set EslesenDegerH = ROTA_FBD.Range("1:1").Find(ArananDegerH.Value)

            If Not EslesenDegerH Is Nothing Then

                Set KontrolHucre = ROTA_FBD.Cells(EslesenDeger.Row, EslesenDegerH.Column)

                If Not IsEmpty(KontrolHucre) Then

                    Fbdsure1 = KontrolHucre.Value ' Hücredeki değeri kaydedin

                Else
                    MsgBox ArananDeger.Value & " ve ekipmanın süresi yok" ' Yeni mesajı göster
                End If

            Else
                MsgBox ArananDeger.Value & " ürününde böyle bir ekipman yok" ' 4 mesajının yerine geçen yeni mesajı göster
            End If

        Else
            Exit For ' If sorgusundan çıkmak için bu satırı kullanın
        End If
        MsgBox Fbdsure1
        
        ' ROTA_BASKI sayfası için
        Set EslesenDeger = ROTA_BASKI.Range("E:E").Find(ArananDeger.Value)

        If Not EslesenDeger Is Nothing Then

            Set ArananDegerI = ONCELIK.Cells(ArananDeger.Row, "I")
            Set EslesenDegerI = ROTA_BASKI.Range("1:1").Find(ArananDegerI.Value)

            If Not EslesenDegerI Is Nothing Then

                Set KontrolHucre = ROTA_BASKI.Cells(EslesenDeger.Row, EslesenDegerI.Column)

                If Not IsEmpty(KontrolHucre) Then

                    Baskisure1 = KontrolHucre.Value ' Hücredeki değeri kaydedin

                Else
                    MsgBox ArananDeger.Value & " ve ekipmanın süresi yok" ' Yeni mesajı göster
                End If

            Else
                MsgBox ArananDeger.Value & " ürününde böyle bir ekipman yok" ' 4 mesajının yerine geçen yeni mesajı göster
            End If

        Else
            Exit For ' If sorgusundan çıkmak için bu satırı kullanın
        End If
        MsgBox Baskisure1
        
        ' ROTA_KAPLAMA sayfası için
        Set EslesenDeger = ROTA_KAPLAMA.Range("E:E").Find(ArananDeger.Value)

        If Not EslesenDeger Is Nothing Then

            Set ArananDegerJ = ONCELIK.Cells(ArananDeger.Row, "J")
            Set EslesenDegerJ = ROTA_KAPLAMA.Range("1:1").Find(ArananDegerJ.Value)

            If Not EslesenDegerJ Is Nothing Then

                Set KontrolHucre = ROTA_KAPLAMA.Cells(EslesenDeger.Row, EslesenDegerJ.Column)

                If Not IsEmpty(KontrolHucre) Then

                    Kaplamasure1 = KontrolHucre.Value ' Hücredeki değeri kaydedin

                Else
                    MsgBox ArananDeger.Value & " ve ekipmanın süresi yok" ' Yeni mesajı göster
                End If

            Else
                MsgBox ArananDeger.Value & " ürününde böyle bir ekipman yok" ' 4 mesajının yerine geçen yeni mesajı göster
            End If

        Else
            Exit For ' If sorgusundan çıkmak için bu satırı kullanın
        End If
        MsgBox Kaplamasure1
        
        ' ROTA_AMBALAJ sayfası için
        Set EslesenDeger = ROTA_AMBALAJ.Range("E:E").Find(ArananDeger.Value)

        If Not EslesenDeger Is Nothing Then

            Set ArananDegerK = ONCELIK.Cells(ArananDeger.Row, "K")
            Set EslesenDegerK = ROTA_AMBALAJ.Range("1:1").Find(ArananDegerK.Value)

            If Not EslesenDegerK Is Nothing Then

                Set KontrolHucre = ROTA_AMBALAJ.Cells(EslesenDeger.Row, EslesenDegerK.Column)

                If Not IsEmpty(KontrolHucre) Then

                    Ambalajsure1 = KontrolHucre.Value ' Hücredeki değeri kaydedin

                Else
                    MsgBox ArananDeger.Value & " ve ekipmanın süresi yok" ' Yeni mesajı göster
                End If

            Else
                MsgBox ArananDeger.Value & " ürününde böyle bir ekipman yok" ' 4 mesajının yerine geçen yeni mesajı göster
            End If

        Else
            Exit For ' If sorgusundan çıkmak için bu satırı kullanın
        End If
        MsgBox Ambalajsure1
    Next ArananDeger
End Sub
"
Bu kodda bir düzenleme yapmanı istiyorum çünkü kod istediğim gibi çalışmıyor. "ONCELIK" sayfasında alttaki boş olan satırları doldurduğumda döngüye katılmalı. Kontrol eder misin? Aynı şekilde "ROTA_GRANUL" sayfasında boş satırları da doldurduğumda döngüye katılması gerekiyor. Hata varsa düzenleyip tüm kodu yazar mısın?