Bağlantı adresini, hücredeki veriye göre değiştirme

[Kalenderist]

Merhaba,
Bir çok klasördeki excel dosyalardaki bazı verileri özet olarak bir başka excel dosyasında toplamak istiyorum.
Bunun içinde veriyi alacağım dosyanın ilgili hücresini aşağıdaki gibi linkledim yan yana bir çok hücreye tek değişen en sondaki hücre bunmarası oluyor.

='H:\XX_M\2. SAHA EKİBİ KANALI İLE GELEN MÜŞTERİ KONTROL SÜRECİ\Toplu Liste\9502413_LATİF TAŞ\[9502413_LATİF TAŞ.xlsx](1) Müşteri Başvuru Kontrolü'!$B$6

Ben bir alt satıra bu defa yine aynı adreste ama başa bir isimli klasör içindeki başka isimli bir excelden veriyi almak istiyorum, bunun için a kolonuna 9502413_LATİF TAŞ yerine 9502414_Ali Veli yazdığımda linkteki önceki isimde a kolonuna yazmış olduğum yeni bilgi ile değişsin.
Yaklaşık 3000 ayrı dosya var, yani alt alta 3000 satır veri olacak aslında

Bu mümkünmü ?
Ctrl+H ile denediğimde olmuyor VBA ile yapılabilir muhtemelen, yardımcı olursanız çok sevinirim.

 

[asi_kral]

Merhaba
Yazdığınız yol sabit ise

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ADRES As String
Application.EnableEvents = False
ADRES = "='H:\XX_M\2. SAHA EKİBİ KANALI İLE GELEN MÜŞTERİ KONTROL SÜRECİ\Toplu Liste\"
If Target.Column = 1 Then
If Intersect(Target, Range("A:A")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Target = ADRES & Target & "\[" & Target & ".xlsx](1) Müşteri Başvuru Kontrolü'!$B$6"
End If
Application.EnableEvents = True
End Sub

Bu kodu sayfanın kod bölümüne ekleyip dener misiniz?

 

[Kalenderist]

Test Dosyası

Örnek Dosyamı ekte paylaşıyorum, yapmaya çalıştığım şey A kolonuna alt alta sırasıyla girilen dosya isimlerine göre yan taraftaki hücrelerdeki adreste de bu dosya isimleri olsun ve ilgili adresten bilgileri alsın.

Yani ben A kolonuna sıra sıra ne giriyorsam B ve sonrası kolonlardaki ilgili hücrelerdeki adreslerin aşağıda renklendirdiğim alanları A kolonundaki bilgiye göre değişsin

='C:\Users\serhat.kalender\Desktop\test\9503115_Test Kontrol\[9503115_Test Kontrol.xlsx](1) Müşteri Başvuru Kontrolü'!$D$20

 

[uzmanamele]

Merhaba

Masaüstünde Kalenderist adlı klasörün içinde Kalende1 ve Kalander2 adında 2 klasör olsun.
Kalender1 klasörü içinde Kitap1.xlsx ve Kalender1 klasörü içinde Kitap1.xlsx olsun
Kalenderist klasöründe ayrıca Kitap.xlsx dosyanıza yazacağınız formül ve ekran görüntüsü ekteki gibi olacaktır.
Dosyalar açıkken verileri alabilirsiniz.

 

[Kalenderist]

Merhaba

Masaüstünde Kalenderist adlı klasörün içinde Kalende1 ve Kalander2 adında 2 klasör olsun.
Kalender1 klasörü içinde Kitap1.xlsx ve Kalender1 klasörü içinde Kitap1.xlsx olsun
Kalenderist klasöründe ayrıca Kitap.xlsx dosyanıza yazacağınız formül ve ekran görüntüsü ekteki gibi olacaktır.
Dosyalar açıkken verileri alabilirsiniz.

Ekli dosyayı görüntüle 233825

Eklediğiniz resminizi göremiyorum, ayrıca çok fazla sayıda klasör ve her birinin içinde excel dosya olduğundan hepsini açmak mümkün değil.
Dosyalar kapalıyken verileri alıyor olmalı, benim rapor dosyamda a kolonuna yazdığı bilgiye göre B kolonu ve sonrasındaki kolonlarda bağlantı adresi A kolonuna göre değişmeli ki veriyi çekebilsin. Bunu sağlamaya çalışıyorum aslında

 

[Kalenderist]

Yardımcı olabilecek var mı acaba?

 

[Korhan Ayhan]

Deneyiniz.

#3 nolu mesajınızda belirttiğiniz şekilde dosya bağlantılarını değiştirir. Farklı yapılarınız varsa değişim yapmayacaktır.

Option Explicit

Sub Formula_Connection_Change()
    Dim Rng As Range, Fso As Object
    Dim XL_Calculation_Mode As Integer
    Dim File_Path As String, New_Path As String
    
    XL_Calculation_Mode = Application.Calculation
    
    Application.ScreenUpdating = False
    Application.Calculation = -4135
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    
    For Each Rng In Range("B4:B" & Cells(Rows.Count, "B").End(3).Row)
        If Rng.HasFormula Then
            If Rng.Offset(, -1) <> "" Then
                File_Path = Replace(Replace(Replace(Left(Rng.Formula, InStr(1, Rng.Formula, "]") - 1), "[", ""), "=", ""), "'", "")
                New_Path = Replace(File_Path, "\" & Fso.GetBaseName(File_Path) & "\[" & Fso.GetBaseName(File_Path) & ".", "\" & Rng.Offset(, -1) & "\[" & Rng.Offset(, -1) & ".")
                If Dir(New_Path) <> "" Then
                    Rng.Replace "\" & Fso.GetBaseName(File_Path) & "\[" & Fso.GetBaseName(File_Path) & ".", "\" & Rng.Offset(, -1) & "\[" & Rng.Offset(, -1) & "."
                End If
            End If
        End If
    Next
    
    Set Fso = Nothing
    
    Application.Calculation = XL_Calculation_Mode
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Formül bağlantıları değiştirilmiştir.", vbInformation
End Sub