kapalı dosyadan veri alma hk.

[maren]

Arkadaşlar ekli dosyada kapalı excel dosyasından a ile c sütunlarından seçip en son 117 satıra kadar hepsini açık olan excel dosyasına aktarmasını istiyorum. fakat o excel dosyası hep farklı olacak yani 117 satır değil de 250 satırda olabilir.
Şimdiden teşekkürler.

 

[Baggwell]

Merhaba

Forumda kapalı dosyadan veri alma diye aratırsanız epey konu mevcut

 

[maren]

Doğrudur arattım 3 gündür de uğraşıyorum hazır dosyalar üzerinden değişiklik yapıyorum fakat bir türlü yapamadım hata veriyor.
Saygılarımla.

 

[Orion1]

Dosyanız ektedir.

Private Sub CommandButton1_Click()
Dim conn As Object, rs As Object, sonsat As Long
Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
sonsat = Cells(Rows.Count, "A").End(xlUp).Row + 1
conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.Path & "\kapalı.xlsm;extended properties=""excel 12.0;hdr=no;imex1"""
rs.Open "select * from [Sayfa1$];", conn, 1, 3
Application.ScreenUpdating = False
If rs.RecordCount > 0 Then Range("A" & sonsat).CopyFromRecordset rs
Application.ScreenUpdating = True
rs.Close
conn.Close
Set rs = Nothing:  Set conn = Nothing
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[igultekin2000]

sayfa seçimi nasıl değişir.

Dosyanız ektedir.

Private Sub CommandButton1_Click()
Dim conn As Object, rs As Object, sonsat As Long
Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
sonsat = Cells(Rows.Count, "A").End(xlUp).Row + 1
conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.Path & "\kapalı.xlsm;extended properties=""excel 12.0;hdr=no;imex1"""
rs.Open "select * from [Sayfa1$];", conn, 1, 3
Application.ScreenUpdating = False
If rs.RecordCount > 0 Then Range("A" & sonsat).CopyFromRecordset rs
Application.ScreenUpdating = True
rs.Close
conn.Close
Set rs = Nothing:  Set conn = Nothing
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

makro sorunsuz çalışor. 15 çalışma sayfası olan çakışma kitabında denedim. sayfalardan birinden bilgileri getiriyor. çalışma sayfasını değiştirme seçeneğini çözemedim. yardımcı olursanız sevinirim. teşekkürler

 

[Orion1]

makro sorunsuz çalışor. 15 çalışma sayfası olan çakışma kitabında denedim. sayfalardan birinden bilgileri getiriyor. çalışma sayfasını değiştirme seçeneğini çözemedim. yardımcı olursanız sevinirim. teşekkürler

sayfa adını kırmızı renkle belirledim.

rs.Open "select * from [[B][COLOR="Red"]Sayfa1$[/COLOR][/B]];", conn, 1, 3

 

[igultekin2000]

bir ilave daha mümkün müdür.

sayfa adını kırmızı renkle belirledim.

rs.Open "select * from [[B][COLOR="Red"]Sayfa1$[/COLOR][/B]];", conn, 1, 3

kullanışı pratik ve hızlı, yanlız makroyu her çalıştırdığımızda verileri boş satıra ekliyor. mevcutları silip yerine yenilerini kaydetse veya mevcutlarda güncelleme yapsa daha kullanışlı olacak gibi, teşekkürler

 

[uKiGS]

sayfa adını kırmızı renkle belirledim.

rs.Open "select * from [[B][COLOR="Red"]Sayfa1$[/COLOR][/B]];", conn, 1, 3

Hocam makronuzu kendi 2 dosyamda denememe rağmen yapamadım. "3 Excel Kayıt" isimli dosyama "mkvc (2)" isimli excel dosyasından A3:A5000 , B3:B5000, C3:C5000 E3:E5000 ve F3:F5000 sütunlarındaki verileri otomatik almasını istiyorum. Eğerki alınan sütunlarda da veri yoksa o zaman hücrenin boş olmasını istiyorum. Yardımlarınızı talep ediyorum.

Teşekkürler.

 

[Orion1]

Hocam makronuzu kendi 2 dosyamda denememe rağmen yapamadım. "3 Excel Kayıt" isimli dosyama "mkvc (2)" isimli excel dosyasından A3:A5000 , B3:B5000, C3:C5000 E3:E5000 ve F3:F5000 sütunlarındaki verileri otomatik almasını istiyorum. Eğerki alınan sütunlarda da veri yoksa o zaman hücrenin boş olmasını istiyorum. Yardımlarınızı talep ediyorum.

Teşekkürler.

Kaynak dosyaları ve hedef dosyayının küçük çapta birer örneklerini yollarsanız daha doğru olacaktır.

 

[uKiGS]

@Orion1
Ayrıca dosyaları başka arkadaşım da kullanacak bu durumda bir sorun olur mu ?

 

[Orion1]

Olacağını sanmıyom.Ayarıca #9 nolu mesajadad cevabım var.

 

[uKiGS]

mkvc (2) excelindeki A B C E F bölümleri 3 Excel Kayıt bölümündeki yerlere otomatik gelsin ve her açtığımda da güncellensin istiyorum. Boş olanlar hücrede de boş olarak kalsın.

Teşekkürler

 

[uKiGS]

Bir de 3 Excel Kayıt sayfasında SKOR SONUÇLAR kısmındaki 1.5 üst,2.5 Üst ASYA SONUÇLAR kısmındaki 1.5 üst, 2.5 ÜST diye uzayan sütunlarda her ikisinde de OK yazıyorsa Tüpçü sonuçlar kısmında Evet desin sadece 1 tanesinde yazıyorsa Hayır yazsın istiyorum. bunu ileride 3 koşulluda yapabilirim onun içinde bilgi verirseniz sevinirim.

Çok teşekkürler.

 

[Orion1]

3 excel sayfasında kod yazdım.O dosyayı açıp TIKLA butonuna basarsanız 2 dosyasından verileri getirecek.
Yalnız bu durumda 2 dosyasından verileri başka bir dosya tarafından açılırsa hata oluşur.
Dosyanız ektedir.

Sub verial_59()
Dim yol As String, dosya As String, sonsat As Long, i As Long
Dim sh As Worksheet, wb As Workbook
yol = ThisWorkbook.Path
dosya = "mkvc (2).xlsm"
Sheets("sayfa1").Select
Range("A3:AC" & Rows.Count).ClearContents
If Dir(yol & "\" & dosya) = "" Then
    MsgBox yol & "\" & dosya & " Bulunamadı!", vbCritical, "UYARI"
    Exit Sub
End If
Workbooks.Open (yol & "\" & dosya)
Set wb = ActiveWorkbook
Set sh = wb.Sheets("sayfa1")
ThisWorkbook.Activate
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 3 To sonsat
    Cells(i, "A").Value = sh.Cells(i, "A").Value
    Cells(i, "B").Value = sh.Cells(i, "B").Value
    Cells(i, "C").Value = sh.Cells(i, "C").Value
    Cells(i, "D").Value = sh.Cells(i, "G").Value
    Cells(i, "E").Value = sh.Cells(i, "H").Value
Next i
Set sh = Nothing
wb.Close False
Application.ScreenUpdating = True
Set wb = Nothing
ThisWorkbook.Activate
MsgBox "İşlem tamamdı.", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[uKiGS]

Hocam harikasınız valla tam istediğim gibi demek az bile kalır Mükemmel olmuş.

Elleriniz emekleriniz dert görmesin çok sağolun.

 

[uKiGS]

3 Excel Kayıt dosyasında Skor sonuçlar Asya Sonuçlar kısmında da 2 mesala 1.5 üst maçlarında ok yazarsa Sayfa 2 de sonuçlar kısmına Sayfa1 deki A,B,C,D ve E Sütunlarındaki ona karşılık gelen oranlar gelsin istiyorum. bu koşulu halledebilir miyiz?

 

[Orion1]

3 Excel Kayıt dosyasında Skor sonuçlar Asya Sonuçlar kısmında da 2 mesala 1.5 üst maçlarında ok yazarsa Sayfa 2 de sonuçlar kısmına Sayfa1 deki A,B,C,D ve E Sütunlarındaki ona karşılık gelen oranlar gelsin istiyorum. bu koşulu halledebilir miyiz?

Buna ait 3-4 satır veri girerseniz,yapmaya çalışırım.

 

[uKiGS]

3 alanda da OK yazısı olanları Sayfa 2 de toplam sonuçlar kısmına ABCDE sütunlarıyla beraber göndermesini istiyorum.

Örnek ektedir.

Saygılarımla.

 

[Orion1]

Alanlar boş.Alanlara bir kaç satır yazarak dosyanızı yollayınız.Deneme yapmam lazım.

 

[uKiGS]

Kusura bakmayın

Buyrun excel ekte.