html uzantılı dosyadan okuma

[oydemir]

Arkadaşlar elimdeki birçok html uzantılı dosyadan bilgi alıyorum hepsini tek tek açıp almaktansa ecelde lazım olan dosyayı çağırıp almak istiyorum. Sitede yardım eden arkadaşlar sayesinde bir kod yazıldı işimi bazı şekilde görüyor fakat tam değil özelikle hisseleri tarih olarak algılıyor. Hücre özelliklerinden metin olarak değiştiriyorum fakat yeni sorguda aynı oluyor. İkinci olarak malikler tek olarak 1 sayfaya getiriyor hâlbuki ikişer üçer olan malikler var ek deki dosyada bunları göreceksiniz yardımlarınız için teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B:A")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
Set s2 = Sheets("Sayfa2")

s2.Cells.ClearContents
With s2.QueryTables.Add(Connection:= _
"URL;file:///" & ThisWorkbook.Path & "/" & Target.Text & ".html", Destination:=s2.Range("$A$1" _
))
.Name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "1,4,3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Cells(Target.Row, "B") = s2.Range("C4")
Cells(Target.Row, "C") = s2.Range("C5")
Cells(Target.Row, "D") = s2.Range("C6")
Cells(Target.Row, "E") = s2.Range("C7")
Cells(Target.Row, "F") = s2.Range("F2")
Cells(Target.Row, "G") = s2.Range("F3")
Cells(Target.Row, "H") = s2.Range("F4")
Cells(Target.Row, "I") = s2.Range("C2")
Cells(Target.Row, "J") = s2.Range("A12")
Cells(Target.Row, "K") = s2.Range("B12")
Cells(Target.Row, "N") = s2.Range("e12")
Cells(Target.Row, "O") = s2.Range("f12")
Cells(Target.Row, "P") = s2.Range("g12")
Cells(Target.Row, "Q") = s2.Range("H12")
Cells(Target.Row, "R") = s2.Range("a13")
Cells(Target.Row, "S") = s2.Range("d20")
Cells(Target.Row, "u") = s2.Range("C8")

Application.EnableEvents = True
End Sub