• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

kapalı dosyadan veri alma hk.

  • Konbuyu başlatan Konbuyu başlatan maren
  • Başlangıç tarihi Başlangıç tarihi
M

maren

Katılım
18 Mayıs 2009
Mesajlar
24
Excel Vers. ve Dili
excel 2008
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.
 

Ekli dosyalar

Merhaba

Forumda kapalı dosyadan veri alma diye aratırsanız epey konu mevcut
 
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.
 
Dosyanız ektedir.:cool:
Kod: 
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
 

Ekli dosyalar

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

Orion1' Alıntı:
Dosyanız ektedir.:cool:
Kod: 
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
Genişletmek için tıkla ...
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
 
igultekin2000' Alıntı:
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
Genişletmek için tıkla ...

sayfa adını kırmızı renkle belirledim.:cool:
Kod: 
rs.Open "select * from [[B][COLOR="Red"]Sayfa1$[/COLOR][/B]];", conn, 1, 3
 
bir ilave daha mümkün müdür.

Orion1' Alıntı:
sayfa adını kırmızı renkle belirledim.:cool:
Kod: 
rs.Open "select * from [[B][COLOR="Red"]Sayfa1$[/COLOR][/B]];", conn, 1, 3
Genişletmek için tıkla ...

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
 
Orion1' Alıntı:
sayfa adını kırmızı renkle belirledim.:cool:
Kod: 
rs.Open "select * from [[B][COLOR="Red"]Sayfa1$[/COLOR][/B]];", conn, 1, 3
Genişletmek için tıkla ...

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.
 
uKiGS' Alıntı:
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.
Genişletmek için tıkla ...
Kaynak dosyaları ve hedef dosyayının küçük çapta birer örneklerini yollarsanız daha doğru olacaktır.:cool:
 
@Orion1
Ayrıca dosyaları başka arkadaşım da kullanacak bu durumda bir sorun olur mu ?
 
Olacağını sanmıyom.Ayarıca #9 nolu mesajadad cevabım var.:cool:
 
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
 

Ekli dosyalar

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.
 
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.
Kod: 
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
 

Ekli dosyalar

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.
 
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?
 
uKiGS' Alıntı:
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?
Genişletmek için tıkla ...
Buna ait 3-4 satır veri girerseniz,yapmaya çalışırım.:cool:
 
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.
 

Ekli dosyalar

Alanlar boş.Alanlara bir kaç satır yazarak dosyanızı yollayınız.Deneme yapmam lazım.:cool:
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst