• DİKKAT

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

TCMB dan kurları getirme

  • Konbuyu başlatan Konbuyu başlatan soykan
  • Başlangıç tarihi Başlangıç tarihi
Katılım
7 Mart 2005
Mesajlar
313
Excel Vers. ve Dili
Excel 2013 Türkçe
Selamlar aşağıda yazdığım makro 2003 ve 2007 sürümlerinde çalışıyor idi. 2010 sürümünü yükledim hata veriyor Excel 2010 da VBA ile ilgili değişiklikler varmı? Üstadlar incelerse çok sevinirim.
On Error GoTo Hata

Sheets("Sayfa1").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.tcmb.gov.tr/kurlar/" & Selection.NumberFormat(Sayfa2.Range("N1"), "yyyymm") & "/" & Selection.NumberFormat(Sayfa2.Range("N1"), "ddmmyyyy") & ".html", Destination:=Range( _
"$A$1"))

.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sayfa2.Activate
Range("C7").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = "=INDIRECT(""Sayfa1!C13"")/10000"
ActiveCell.Offset(0, 1).Value = "=INDIRECT(""Sayfa1!D13"")/10000"
ActiveCell.Offset(0, 2).Value = "=INDIRECT(""Sayfa1!C16"")/10000"
ActiveCell.Offset(0, 3).Value = "=INDIRECT(""Sayfa1!D16"")/10000"
ActiveCell.Offset(0, 4).Value = "=RC[-2]/RC[-4]"
ActiveCell.Offset(0, 5).Value = "=INDIRECT(""Sayfa1!C17"")/10000"
ActiveCell.Offset(0, 6).Value = "=INDIRECT(""Sayfa1!D17"")/10000"
ActiveCell.Offset(0, 7).Value = "=RC[-1]/RC[-7]"
ActiveCell.Offset(0, 8).Value = "=RC[-3]/RC[-6]"
Range("B7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("B7").Select
Application.CutCopyMode = False
Exit Sub
Hata:
MsgBox "İnternet Bağlantınızı Kontrol Edin veya Henüz Merkez Bankası Kurları Açıklanmamış"
Sayfa2.Activate
ActiveWorkbook.Save
End Sub
 
Geri
Üst