Dış veri alma Sayfa1 deki linklerden diğer sayfalara

[ali14]

Arkadaşlar tekrar uzun bir aradan sonra bende burdayım.Herkeze merhaba.
Ben burda daha önce buna benzer hatta tam aynısı bi konu açmıştım yardımcı olan arkadaşların bana gönderdiği örnek projeleri kullanıyordum.Benim sistem hep çöker bende burdan dosyayı tekrar indiiyordum fakat burada çökünce bende ortada kaldım.
Sorum:sayfa 1 deki linklerdeki verileridiğer sayfalara otamatik olarak dış veri olarak almak Proje aşağıda
Zaman ayırırsanız çok sevinirim
İyi geceler

 

[ali14]

Arkadaşlar bu konuya bi cevabı olan yok mu lütfen .

 

[ali14]

Arkadaslar bu konu gercekten benim icin cok onemli lufen konu hakkında bilgisi olan arkadaslar varsa yardımlarınızı bekliyorum.(OOOFF OFF Dosyaların arsivden silinmesi hakkatten butuk talihsizlik)

 

[Korhan Ayhan]

Selamlar,

Belirttiğiniz linkleri açtığımda veri al bölümünde sadece sitenin reklam bölümünü almaya müsade ediyor. Yani veri bulunan kısımda sarı işaretleme okları bende görünmüyor. Bu sebeple bahsettiğiniz siteden excele veri aktarılamıyor.

 

[ali14]

kardesler yardım edene de etmeyenede tesekkurler

korhan bey selamlar
Ben yeni tasarım ekledim bi bakabilirseniz ben yanlıs yerei tarif ediyomusum o sarı buton arac cubugun daki gitin yanındaki sarı okmus yani sayfadaki tum sarı okları kaldırıyo ve sayfanın tümünü al diyo dosya ekte
Saygılar
Ali Simsek

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.


Kullanılan kod;

Option Explicit
 
Sub VERİ_AL()
    Dim SAYFA As Worksheet, X As Long, URL_LİNK As String
 
    Application.ScreenUpdating = False
 
    For Each SAYFA In Worksheets
        If SAYFA.Name <> "ANA_SAYFA" Then
        Application.DisplayAlerts = False
        SAYFA.Delete
        Application.DisplayAlerts = True
        End If
    Next
 
    For X = 1 To Sheets("ANA_SAYFA").Range("A65536").End(3).Row
 
    URL_LİNK = Sheets("ANA_SAYFA").Cells(X, 1)
 
    ActiveWorkbook.Worksheets.Add , After:=Sheets(Worksheets.Count)
 
    ActiveSheet.Name = "ANALİZ_" & X
 
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & URL_LİNK, Destination:=Range("A1"))
        .Name = "ANALİZ_" & X
        .FieldNames = True
        .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
 
    Next
 
    Sheets("ANA_SAYFA").Select
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ali14]

Duyarlılıgın icin cok tesk

ZAMAN AYIRDIGIN İCİN COK TSK.BU BENİM İCİN COK ONEMLİ İDİ COK SAOL

ActiveSheet.Name = "ANALİZ_" & X

YAZANYERE "b213"& X YAZSAM OLURMU CUNKU HİSSE ADI B SUTUNU 213 CU SATIRDA SAYFALARI KENDİ İSMİ İLE OLSUN DİYE

UMARIM TUM ARKADASLARA BU KODLAR YARAR.
SAYGILAR
ALİ

 

[Korhan Ayhan]

Selamlar,

Bir index numarası oluşsun diye o ismi vermiştim. Siz dilediğiniz ismi verebilirsiniz.

 

[Korhan Ayhan]

Selamlar,

Özel mesajdan sorduğunuz sorunuza göre kodda aşağıdaki bölümü "True" olarak ayarlarsanız "Tarih tanımayı devre dışı bırak" seçeneğini aktif hale getirmiş olsursunuz.

Eski hali;

WebDisableDateRecognition = False

Yeni hali;

WebDisableDateRecognition = True

Not: Lütfen sorularınızı foruma sorunuz. Özelden sorduğunuzda paylaşımın hiçbir amacı kalmıyor.

 

[ali14]

teşekkür ederim