Merhaba,
Aşağıda yer alan ve "Link Update BE" adlı çalışma kitabında ABC1 sayfasında yarattığım codu görebilirsiniz. Macro ABC1 sayfasında girilen verilere göre çalışıyor. ABC2 diye bir sayfa yaratıp, (ABC1 ile aynı formatta ve taslakta) aynı makroyu burada da devam ettirmesini istiyorum. Ancak ABC1 sayfasındaki verilerle yazdığım döngülerde diğer sayfaya geçtiğinde bu sefer ABC2 sayfasındaki verilerle devam etmeli. Sheet isimlerinin değişken olması ve tek makronun bütün sayfalarda çalışmasını yapmak istiyorum. Yardım rica ederim. (sheet ismi gereken yerleri aşağıda kırmızı ile boyadım)
Sub BESTLinkChange()
'ilk olarak değiştirmek istediğimiz linklerin içinde şifreli olan var ise bu exceli açmakla başlıyoruz.
ChDir "R:\FN\BR\6)Projects\5) Sistem konsolidasyon"
Workbooks.Open Filename:= _
"C:\Tarih Güncelleme.xlsx", Password:="WAS"
Application.Wait (Now + TimeValue("00:00:05"))
Sheets("CONS-Genel").Select
Windows("Link Update BE.xlsm").Activate
Sheets("ABC1").Select
SIFRELIPATH = Range("C2").Value
SIFRELIEXCEL = Range("D2").Value
ANAEXCEL = Range("D1").Value
ANAPATH = Range("C1").Value
Workbooks.Open ANAPATH, Password:="321", Writerespassword:="123", UpdateLinks:=0, IgnoreReadOnlyRecommended:=True, Notify:=False 'Bu exceldeki C1 hücresini WB_Guncelle olarak değişkene ata
Application.DisplayAlerts = False
Windows("Link Update BE.xlsm").Activate
Dim Açılacak As Variant
Dim WB_Cari As Workbook
Dim wb As String
Workbooks("Link Update BE.xlsm").Activate
Sheets("ABC1").Range("C1").Activate
Do
Açılacak = ActiveCell.Offset(1, 0).Text
wb = Açılacak
Workbooks.Open wb, Password:="321", Writerespassword:="123", UpdateLinks:=0, IgnoreReadOnlyRecommended:=True, Notify:=False, ReadOnly:=True 'Bu exceldeki C1 hücresini WB_Guncelle olarak değişkene ata
Application.DisplayAlerts = False
Windows("Link Update BE.xlsm").Activate
ActiveCell.Offset(0, -2) = "Ok"
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(1, 0).Value = "" Then Exit Do
Loop
Workbooks("Link Update BE.xlsm").Activate
Dim Eski As Variant, Yeni As Variant
Sheets("ABC1").Range("b28").Activate
Do
Eski = ActiveCell.Offset(0, 0).Text
Yeni = ActiveCell.Offset(0, 1).Text
Windows(ANAEXCEL).Activate
ActiveWorkbook.ChangeLink Name:= _
Eski _
, NewName:= _
Yeni _
, Type:=xlExcelLinks
Workbooks("Link Update BE.xlsm").Activate
ActiveCell.Offset(0, -1) = "Ok"
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(1, 0).Value = "" Then Exit Do
Loop
Windows(ANAEXCEL).Activate
Debug.Print ActiveWorkbook.Name
ActiveWorkbook.Close SaveChanges:=True
Windows("Tarih Güncelleme.xlsx").Activate
Debug.Print ActiveWorkbook.Name
ActiveWorkbook.Close SaveChanges:=True
Windows("Link Update BE.xlsm").Activate
Dim Kapanacak As Variant
Workbooks("Link Update BE.xlsm").Activate
Sheets("ABC1").Range("C1").Activate
Do
Kapanacak = ActiveCell.Offset(1, 0).Text
wb = Kapanacak
Workbooks.Open wb
ActiveWorkbook.Close SaveChanges:=False
Windows("Link Update BE.xlsm").Activate
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(1, 0).Value = "" Then Exit Do
Loop
End Sub
Aşağıda yer alan ve "Link Update BE" adlı çalışma kitabında ABC1 sayfasında yarattığım codu görebilirsiniz. Macro ABC1 sayfasında girilen verilere göre çalışıyor. ABC2 diye bir sayfa yaratıp, (ABC1 ile aynı formatta ve taslakta) aynı makroyu burada da devam ettirmesini istiyorum. Ancak ABC1 sayfasındaki verilerle yazdığım döngülerde diğer sayfaya geçtiğinde bu sefer ABC2 sayfasındaki verilerle devam etmeli. Sheet isimlerinin değişken olması ve tek makronun bütün sayfalarda çalışmasını yapmak istiyorum. Yardım rica ederim. (sheet ismi gereken yerleri aşağıda kırmızı ile boyadım)
Sub BESTLinkChange()
'ilk olarak değiştirmek istediğimiz linklerin içinde şifreli olan var ise bu exceli açmakla başlıyoruz.
ChDir "R:\FN\BR\6)Projects\5) Sistem konsolidasyon"
Workbooks.Open Filename:= _
"C:\Tarih Güncelleme.xlsx", Password:="WAS"
Application.Wait (Now + TimeValue("00:00:05"))
Sheets("CONS-Genel").Select
Windows("Link Update BE.xlsm").Activate
Sheets("ABC1").Select
SIFRELIPATH = Range("C2").Value
SIFRELIEXCEL = Range("D2").Value
ANAEXCEL = Range("D1").Value
ANAPATH = Range("C1").Value
Workbooks.Open ANAPATH, Password:="321", Writerespassword:="123", UpdateLinks:=0, IgnoreReadOnlyRecommended:=True, Notify:=False 'Bu exceldeki C1 hücresini WB_Guncelle olarak değişkene ata
Application.DisplayAlerts = False
Windows("Link Update BE.xlsm").Activate
Dim Açılacak As Variant
Dim WB_Cari As Workbook
Dim wb As String
Workbooks("Link Update BE.xlsm").Activate
Sheets("ABC1").Range("C1").Activate
Do
Açılacak = ActiveCell.Offset(1, 0).Text
wb = Açılacak
Workbooks.Open wb, Password:="321", Writerespassword:="123", UpdateLinks:=0, IgnoreReadOnlyRecommended:=True, Notify:=False, ReadOnly:=True 'Bu exceldeki C1 hücresini WB_Guncelle olarak değişkene ata
Application.DisplayAlerts = False
Windows("Link Update BE.xlsm").Activate
ActiveCell.Offset(0, -2) = "Ok"
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(1, 0).Value = "" Then Exit Do
Loop
Workbooks("Link Update BE.xlsm").Activate
Dim Eski As Variant, Yeni As Variant
Sheets("ABC1").Range("b28").Activate
Do
Eski = ActiveCell.Offset(0, 0).Text
Yeni = ActiveCell.Offset(0, 1).Text
Windows(ANAEXCEL).Activate
ActiveWorkbook.ChangeLink Name:= _
Eski _
, NewName:= _
Yeni _
, Type:=xlExcelLinks
Workbooks("Link Update BE.xlsm").Activate
ActiveCell.Offset(0, -1) = "Ok"
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(1, 0).Value = "" Then Exit Do
Loop
Windows(ANAEXCEL).Activate
Debug.Print ActiveWorkbook.Name
ActiveWorkbook.Close SaveChanges:=True
Windows("Tarih Güncelleme.xlsx").Activate
Debug.Print ActiveWorkbook.Name
ActiveWorkbook.Close SaveChanges:=True
Windows("Link Update BE.xlsm").Activate
Dim Kapanacak As Variant
Workbooks("Link Update BE.xlsm").Activate
Sheets("ABC1").Range("C1").Activate
Do
Kapanacak = ActiveCell.Offset(1, 0).Text
wb = Kapanacak
Workbooks.Open wb
ActiveWorkbook.Close SaveChanges:=False
Windows("Link Update BE.xlsm").Activate
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(1, 0).Value = "" Then Exit Do
Loop
End Sub