Dizi kodunda hata

[tamer42]

Merhaba,

Aşağıdaki dizi oluşturma kodunu çalıştırdığımda;
"run-time '9': subscript out of range" hatası alıyorum, nerede hata yapıyor olabilirim?

Set WS = Sheets(Syf)

 Const str = "BÜLBÜL"
    
With WS
    LR = .Cells(.rows.count, "A").End(xlUp).row
    Set Rng = .Range("D2:D" & LR)
End With

        ReDim My_List(1 To 1, 1 To 7)
        
        For Each My_Cell In Rng
            If My_Cell.Value Like str & "*" Then
                x = x + 1
                r = My_Cell.row
                ReDim Preserve My_List(1 To x, 1 To 7)
                    For j = 1 To 7
                        My_List(x, j) = WS.Cells(r, j)
                    Next j
                    
             Stop
            End If
        Next

Teşekkürler, iyi çalışmalar.

 

[halit3]

satır ve sutunları yer değiştirip yapın
veya değiken satırın değişkenliğini iptal adin net satır sayısını yazınız.

 

[tamer42]

satır ve sutunları yer değiştirip yapın
veya değiken satırın değişkenliğini iptal adin net satır sayısını yazınız.

Halit Hocam ilgi ve alakanıza teşekkürler;
Düzenlemeyi kod üzerindeki satırda gösterebilir misiniz?

 

[halit3]

ReDim My_List(1 To 1, 1 To 7)
ReDim Preserve My_List(1 To x, 1 To 7)
My_List(x, j) = WS.Cells(r, j)
yukarıdaki bölümleri aşağıdaki ile değiştirin
ReDim My_List(1 To 7, 1 To 1)
ReDim Preserve My_List(1 To 7, 1 To x)
My_List(j, x) = WS.Cells(r, j)


veya

ReDim My_List(1 To 1, 1 To 7)
yukarıdaki bölümü aşağıdaki ile değiştir
ReDim My_List(1 To 100, 1 To 7)
ReDim Preserve My_List(1 To x, 1 To 7) bu bölümüde sil

 

[tamer42]

ReDim My_List(1 To 1, 1 To 7)
ReDim Preserve My_List(1 To x, 1 To 7)
My_List(x, j) = WS.Cells(r, j)
yukarıdaki bölümleri aşağıdaki ile değiştirin
ReDim My_List(1 To 7, 1 To 1)
ReDim Preserve My_List(1 To 7, 1 To x)
My_List(j, x) = WS.Cells(r, j)


veya

ReDim My_List(1 To 1, 1 To 7)
yukarıdaki bölümü aşağıdaki ile değiştir
ReDim My_List(1 To 100, 1 To 7)
ReDim Preserve My_List(1 To x, 1 To 7) bu bölümüde sil

Teşekkürler Halit Hocam