ADO Veri Alma Makrosu

[1Al2Ver]

Merhaba,

Masaüstünde "KİTAP" isimli bir klasör mevcut,

Klasörde ise "Alan" ve "Kaynak" isimli dosyalar var,

"Kaynak" isimli dosya kapalı, "Alan" isimli dosya açık,

Kapalı olan "Kaynak" isimli dosyanın, Sayfa1'inde G4:G aralığındaki verileri, Açık olan "Alan" isimli dosyanın B2:B aralığına almak istiyorum,

Yaptığım tüm denemeler başarısız oldu, örneğin ;

Set S1 = Workbooks("KAYNAK.xls").Sheets("Sayfa1") "ALAN" yaptım

If Dosya.Name <> "KAYNAK.xls" Then "ALAN" yaptım

Range aralıklarını farklı sütun ve satır ile denedim,

Aşağıdaki kodu bu doğrultuda düzenler misiniz, düzenlenen kodu nereye (dosya ve sayfa) kayıt etmeliyim ?

Teşekkür ederim,

Sub VERİ AL ()
Application.ScreenUpdating = False
Dosya_Yolu = "C:\Documents and Settings\Admin\Desktop\KİTAP\"
Set S1 = Workbooks("KAYNAK.xls").Sheets("Sayfa1")
S1.Select
[B2:B65536].ClearContents
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each Dosya In Klasör
If InStr(Dosya.Name, ".xls") > 0 Then
If Dosya.Name <> "KAYNAK.xls" Then
Workbooks.Open Filename:=Dosya
Sheets("Sayfa1").Select
Range("G4:G" & [G65536].End(3).Row).Copy S1.Cells(65536, 2).End(3).Offset(1)
ActiveWorkbook.Close True
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Orion1]

2 tane küçük örnek dosya yolayınız.

 

[1Al2Ver]

2 tane küçük örnek dosya yolayınız.

Memnuniyetle Sayın Evren Gizlen,

Teşekkür ederim.

 

[Orion1]

Dosyanız ektedir.
2 dosyanıunda ayni klasör içinde olması lazım.
Excel4 makro ile yapıldı.

Sub VERİ_AL()
Dim i As Long, son As Long, sat As Long
sat = 2
    Sheets("Sayfa3").Select
    Application.ScreenUpdating = False
    Range("B2:B65536").ClearContents
    son = Application.ExecuteExcel4Macro("COUNTA('" & ThisWorkbook.Path & "\[Kaynak.xls]Sayfa1'!C7)") + 2
    For i = 4 To son
        Cells(sat, "B").Value = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[Kaynak.xls]Sayfa1'!R" & i & "C7")
        sat = sat + 1
    Next
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[1Al2Ver]

Sayın Evren Gizlen, merhaba,

Çözüm için çok teşekkür ederim,

...."\[Kaynak.xls]Sayfa1'!C7)") + 2

...\[Kaynak.xls]Sayfa1'!R" & i & "C7")

C7 ve +2 için açıklama rica edebilir miyim, şu nedenle;

Şayet aktarılan ve alınan sütun-hücre adreslerinde bir değişiklik yapmak istersem, değiştirmem gerekenleri bilmek ve kendim birşeyler yapmak isterim,

Teşekkür ederim.

 

[Orion1]

Sayın Evren Gizlen, merhaba,

Çözüm için çok teşekkür ederim,

...."\[Kaynak.xls]Sayfa1'!C7)") + 2

...\[Kaynak.xls]Sayfa1'!R" & i & "C7")

C7 ve +2 için açıklama rica edebilir miyim, şu nedenle;

Şayet aktarılan ve alınan sütun-hücre adreslerinde bir değişiklik yapmak istersem, değiştirmem gerekenleri bilmek ve kendim birşeyler yapmak isterim,

Teşekkür ederim.

C=Column(sütun)
R=Row(Satır)
C7 bu durumda 7nci sütun oluyor.
+2 is tıpkı bağ_değ_dolu_say ile nasıl dolu hücreleri sayıyorsak onun gibi CONTA iş yapıyor..En üstten 2 satır boş olduğu için son satır 2 eksik vercekti.
onuda bertaradf etmek için boş satır sayaısı kadar ekleme yaptık.Sizin sütununzda 2 satır üstten boştu o nedenle 2 ekledik.
Bilmem anlatabildimmi.

 

[1Al2Ver]

C=Column(sütun)
R=Row(Satır)
C7 bu durumda 7nci sütun oluyor.
+2 is tıpkı bağ_değ_dolu_say ile nasıl dolu hücreleri sayıyorsak onun gibi CONTA iş yapıyor..En üstten 2 satır boş olduğu için son satır 2 eksik vercekti.
onuda bertaradf etmek için boş satır sayaısı kadar ekleme yaptık.Sizin sütununzda 2 satır üstten boştu o nedenle 2 ekledik.
Bilmem anlatabildimmi.

Sayın Evren Gizlen, merhaba,

Açıklamalar için teşekkür ederim, saygılarımla.

 

[Orion1]

Sayın Evren Gizlen, merhaba,

Açılamalar için teşekkür ederim, saygılarımla.

Rica ederim.
Saygılar benden.