Yardım Makro ile Dinamik Düşeyara-Eğerhata

Function GetData(uretimEmriNumarasi As String, dosyaYol As String) As Variant
    Dim dosya As Workbook
    Dim dosyaYolu1 As String, dosyaYolu2 As String
    Dim veri As Variant
    
    ' İlk dosya yolunu oluştur
    dosyaYolu1 = dosyaYol & "Fason\" & "[" & dosyaYol & uretimEmriNumarasi & ".xlsx]Ürün Takip Formu'!$B$1:$T$25"
    
    ' İkinci dosya yolunu oluştur
    dosyaYolu2 = dosyaYol & "Faturalanmis Irsaliyeler\" & "[" & dosyaYol & uretimEmriNumarasi & ".xlsx]Ürün Takip Formu'!$B$1:$T$25"
    
    ' İlk dosyayı dene
    On Error Resume Next
    Set dosya = Workbooks.Open(dosyaYolu1)
    On Error GoTo 0
    
    ' Eğer dosya açıldıysa veriyi al
    If Not dosya Is Nothing Then
        veri = dosya.Sheets("Ürün Takip Formu").Range("B1:T25").Value
        dosya.Close False ' Dosyayı kapat
        GetData = veri
        Exit Function
    End If
    
    ' İkinci dosyayı dene
    On Error Resume Next
    Set dosya = Workbooks.Open(dosyaYolu2)
    On Error GoTo 0
    
    ' Eğer ikinci dosya açıldıysa veriyi al
    If Not dosya Is Nothing Then
        veri = dosya.Sheets("Ürün Takip Formu").Range("B1:T25").Value
        dosya.Close False ' Dosyayı kapat
        GetData = veri
    Else
        ' Dosya bulunamazsa veya açılamazsa hatayı döndür
        GetData = CVErr(xlErrValue)
    End If
End Function

Sub VeriCekme()
    Dim uretimEmriNumarasi As String
    Dim dosyaYol As String
    Dim sonuc As Variant
    
    ' Örnek üretim emri numarası ve dosya yolu
    uretimEmriNumarasi = Range("L2").Value ' L sütununda üretim emri numarası
    dosyaYol = "\\fserver\Data\Kalite Kontrol\Kalitekontrol Ortak Alan\Fason Irsaliyeler\Gunluk Irsaliyeler\"
    
    ' Veriyi çek
    sonuc = GetData(uretimEmriNumarasi, dosyaYol)
    
    ' Sonucu hücrelere yaz
    If IsArray(sonuc) Then
        Range("A1").Resize(UBound(sonuc, 1), UBound(sonuc, 2)).Value = sonuc
    Else
        ' Eğer hata dönerse hata mesajını göster
        MsgBox "Veri çekme işlemi başarısız oldu!", vbExclamation
    End If
End Sub

Private Sub CommandButton3_Click()
    Dim AnaDosya As Workbook
    Dim AnaSayfa As Worksheet
    Dim UretimEmriSutun As Range
    Dim DosyaYolW As Range
    Dim DosyaYolX As Range
    Dim EkleSutun As Range
    Dim DosyaYolu As String
    Dim DosyaAdresi As String
    Dim Dosya As Workbook
    Dim UretimEmri As Variant
    Dim Sonuc As Variant
    Dim DosyaSayfa As Worksheet
    Dim DosyaSira As Long


    Set AnaDosya = ThisWorkbook
    Set AnaSayfa = AnaDosya.Sheets("Takip6")

    
    Set UretimEmriSutun = AnaSayfa.Range("B3:B" & AnaSayfa.Cells(Rows.Count, "B").End(xlUp).Row)
    Set DosyaYolW = AnaSayfa.Range("W3:W" & AnaSayfa.Cells(Rows.Count, "W").End(xlUp).Row)
    Set DosyaYolX = AnaSayfa.Range("X3:X" & AnaSayfa.Cells(Rows.Count, "X").End(xlUp).Row)
    Set EkleSutun = AnaSayfa.Range("M3:M" & AnaSayfa.Cells(Rows.Count, "M").End(xlUp).Row)

  
    DosyaYolu = "\\fserver\Data\Kalite Kontrol\Kalitekontrol Ortak Alan\Fason Irsaliyeler\Gunluk Irsaliyeler\DeryaFason\"

    
    For i = 1 To UretimEmriSutun.Rows.Count
    
        If Not IsEmpty(UretimEmriSutun.Cells(i, 1).Value) Then
            UretimEmri = UretimEmriSutun.Cells(i, 1).Value

           
            If Not IsEmpty(DosyaYolW.Cells(i, 1).Value) Then
                DosyaAdresi = DosyaYolW.Cells(i, 1).Value
            ElseIf Not IsEmpty(DosyaYolX.Cells(i, 1).Value) Then
                DosyaAdresi = DosyaYolX.Cells(i, 1).Value
            End If

           
            If Len(DosyaAdresi) > 0 Then
                
                Set Dosya = Application.Workbooks.Open(DosyaAdresi, UpdateLinks:=0, ReadOnly:=True)

                On Error Resume Next
                Set DosyaSayfa = Dosya.Sheets(1)
                On Error GoTo 0

                If Not DosyaSayfa Is Nothing Then
                  
                    DosyaSira = WorksheetFunction.Match(UretimEmri, DosyaSayfa.Range("B:B"), 0)

                    Sonuc = DosyaSayfa.Cells(DosyaSira, "M").Value
                Else
                    Sonuc = "Sayfa Bulunamadı"
                End If

              
                EkleSutun.Cells(i, 1).Value = Sonuc

               
                Dosya.Close SaveChanges:=False
            Else
                
                MsgBox "Üretim Emri için uygun dosya adresi bulunamadı.", vbExclamation
            End If
        End If
    Next i
End Sub