makro ile köprüleme

[eagle03]

İyi günler
makro kullanarak bir çalışma kitabındaki herhangi bir hücreyi bir başka çalışma kitabına köprülemek istiyorum. Makro kullanmaya yeni başladım ve nasıl yapılacağını bulamadım. Bunun hakkındaki bütün konularda aynı çalışma kitabındaki farklı çalışma sayfalarına köprüleme yapılmış. kendi uğraşlarımla yazdığım kod pek sonuç vermiyor. Köprüleme gerçekleşiyor ancak tıkladığımda dosya açılmıyor. Yardımcı olursanız çok memnun olurum

kod:

Sub arsiv()
Dim i As Integer, k As Integer, n As Integer, s As String
k = 2
n = Sheets("VERİ GİRİŞİ").Cells(6, 2).Value
ActiveWorkbook.SaveAs Filename:="C:\Users\mrplus\Desktop\MRPLUS\arşiv\" & Format(Date, "mm-dd-yyyy") & " - " & Sheets("VERİ GİRİŞİ").Range("B5").Value & ".xlsm"
s = "C:\Users\mrplus\Desktop\MRPLUS\arşiv\" & Format(Date, "mm-dd-yyyy") & " - " & Sheets("VERİ GİRİŞİ").Range("B5").Value & ".xlsm"
For k = 2 To 10000
If Sheets("ARŞİV").Cells(k, 1).Value = "" Then
Sheets("ARŞİV").Cells(k, 1).Value = k - 1
Sheets("ARŞİV").Cells(k, 2).Value = Sheets("VERİ GİRİŞİ").Cells(5, 2).Value
Sheets("ARŞİV").Cells(k, 3).Value = Sheets("VERİ GİRİŞİ").Cells(6, 2).Value
Sheets("ARŞİV").Cells(k, 4).Value = Sheets("VERİ GİRİŞİ").Cells(9, 2).Value
Sheets("ARŞİV").Cells(k, 5).Value = Sheets("VERİ GİRİŞİ").Cells(12, 2).Value
For i = 3 To n + 1
Sheets("ARŞİV").Cells(k, 4).Value = " " & Sheets("ARŞİV").Cells(k, 4).Value & " " & Sheets("VERİ GİRİŞİ").Cells(9, i).Value
Sheets("ARŞİV").Cells(k, 5).Value = " " & Sheets("ARŞİV").Cells(k, 5).Value & " " & Sheets("VERİ GİRİŞİ").Cells(12, i).Value
Next i
Sheets("ARŞİV").Cells(k, 6).Value = Sheets("VERİ GİRİŞİ").Cells(4, 2).Value
Sheets("ARŞİV").Cells(k, 7).Value = Format(Date, "mm-dd-yyyy")
Sheets("ARŞİV").Activate
Sheets("ARŞİV").Cells(k, 8).Select
Sheets("ARŞİV").Cells(k, 8).Hyperlinks.Add Anchor:=Selection, Address:=s, TextToDisplay:="link" & k - 1
Exit For
End If
Next k

End Sub

 

[bedersu]

Sayın eagle3,

n = Sheets("VERİ GİRİŞİ").Cells(6, 2).Value
ActiveWorkbook.SaveAs Filename:="C:\Users\mrplus\Desktop\MRPLUS\arşiv\" & Format(Date, "mm-dd-yyyy") & " - " & Sheets("VERİ GİRİŞİ").Range("B5").Value & ".xlsm"
s = "C:\Users\mrplus\Desktop\MRPLUS\arşiv\" & Format(Date, "mm-dd-yyyy") & " - " & Sheets("VERİ GİRİŞİ").Range("B5").Value & ".xlsm"

Kodlarda verilen link ile farklı kaydedilen dosya isimleri aynı yerden yani Range("B5")'ten alınıyor.Dolayısıyla verilen linkteki dosya zaten açık.