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
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
