• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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
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
 
İ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
 
Geri
Üst