Hücredeki linke tıklayınca "Bu dosyayı açmak istermisiniz" diye sormasın

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Altın Üyelik Bitiş Tarihi
07-02-2024
Merhaba arkadaşlar.
Aşağıdaki makro ile Türkiye İstatistik Kurumu tarafından yayınlanan aylık istatistiki bilgileri çalışma sayfama kopyalıyorum.
Sizlerden ricam
1-) I1:I3 aralığındaki linlerin silinmeye karşı korunabilmesi için makroya ilave edilmesi
I1 deki link: http://www.tuik.gov.tr/PreIstatistik...o?istab_id=664
I2 deki link: http://www.tuik.gov.tr/PreIstatistik...o?istab_id=654
I3 deki link: http://www.tuik.gov.tr/PreIstatistik...o?istab_id=661
2-) Dosyayı açmak istermisiniz sorusu sorulmadan ilgili linklerin açılarak güncelleme işleminin gerçekleşmesi ve açılan linklerin tekrar kendiliğinden kapatılması.
Kod:
Sub TEFE_() 
    Range("I1").Select 
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Range("B5:O13").Select
    Selection.Copy
    Windows("Maliyet1.xls").Activate
    Sheets("Sayfa1").Select
    Range("I7:V16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
 
    Range("I2").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Range("B5:O13").Select
    Selection.Copy
    Windows("Maliyet1.xls").Activate
    Sheets("Sayfa1").Select
    Range("I20:V29").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
 
    Range("I3").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Range("A7:AO115").Select
    Selection.Copy
    Windows("Maliyet1.xls").Activate
    Sheets("Sayfa1").Select
    Range("I37:AW135").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
     [a1].Select
End Sub
 
Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Altın Üyelik Bitiş Tarihi
07-02-2024
İyi geceler arkadaşlar.
Sorunumu aşağıdaki makro ile çözdüm.
Faydalı olması dileği ile.
Kod:
Sub TEFE_()
    Workbooks.Open("http://www.tuik.gov.tr/PreIstatistikTablo.do?istab_id=664").Worksheets("18_t5").Activate
    Range("B5:O13").Select
    Selection.Copy
    Windows("Maliyet.xls").Activate
    Sheets("Endeks").Select
    Range("I7:V16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Workbooks("PreIstatistikTablo.do").Close
    
    Workbooks.Open("http://www.tuik.gov.tr/PreIstatistikTablo.do?istab_id=654").Worksheets("17_t5").Activate
    Range("B5:O13").Select
    Selection.Copy
    Windows("Maliyet.xls").Activate
    Sheets("Endeks").Select
    Range("I20:V29").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Workbooks("PreIstatistikTablo.do").Close
   
    Workbooks.Open("http://www.tuik.gov.tr/PreIstatistikTablo.do?istab_id=661").Worksheets("18_t2").Activate
    Range("A7:AO115").Select
    Selection.Copy
    Windows("Maliyet.xls").Activate
    Sheets("Endeks").Select
    Range("I37:AW135").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Workbooks("PreIstatistikTablo.do").Close
     [a1].Select
End Sub
 
Üst