• DİKKAT

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

diğer çalışma kitabından veri aktarma hk

  • Konbuyu başlatan Konbuyu başlatan zamenya
  • Başlangıç tarihi Başlangıç tarihi
Z

zamenya

Katılım
15 Haziran 2008
Mesajlar
300
Excel Vers. ve Dili
Excel-2007 Türkçe
arkadaşlar merhaba
iki adet çalışma kitabım var veri ve data adlı, veri çalışma kitabının ilk A SÜTÜNÜN DAN K stününAKADAR data sayfasına ve en son dolu hüçenin altına nasıl aktattırabilirim ve her aktarmada en son dolu hücernin altına aktattırmam gerekiyor
 

Ekli dosyalar

Kod: 
Sub aktar()
    Set baglanti = CreateObject("ADODB.Connection")
    yol = "DRIVER={Microsoft Excel Driver (*.xls)};" & "DBQ=" & ThisWorkbook.Path & "\veri.xls"
    baglanti.Open yol
    Set rs = baglanti.Execute("[veri$a1:k1000]")
    [a2].CopyFromRecordset rs
    rs.Close
    baglanti.Close
End Sub
şeklinde deneyin.
 
SAYIN HAMİTCAN
Zamenya için vermiş olduğunuz makro çok işime yarayacak
Ancak şu şekilde bir değişiklik yapılabilirmi?
Aktar makrosuna tıkladığımızda klasör açma penceresinden bilgisayarın istediğimiz yerinden istediğimiz dosyayı şeçerek seçtiğimiz dosyadaki bilgileri aynı şekilde aktarabilirmiyiz. Seçtiğimiz dosya ismi farkllı olabilir.
Yardımlarınız için şimdiden teşekkürler
 
sayın hamitcan yardımınız için çok teşekkürler
 
SAYIN HAMİTCAN
3 Numaralı mesajım için cevabınızı bekliyorum.
teşekkürler
 
SAYIN HAMİTCAN
3 Numaralı mesajım için cevabınızı bekliyorum.
teşekkürler
 
cebelitarık' Alıntı:
SAYIN HAMİTCAN
Zamenya için vermiş olduğunuz makro çok işime yarayacak
Ancak şu şekilde bir değişiklik yapılabilirmi?
Aktar makrosuna tıkladığımızda klasör açma penceresinden bilgisayarın istediğimiz yerinden istediğimiz dosyayı şeçerek seçtiğimiz dosyadaki bilgileri aynı şekilde aktarabilirmiyiz. Seçtiğimiz dosya ismi farkllı olabilir.
Yardımlarınız için şimdiden teşekkürler
Genişletmek için tıkla ...

Evet, koda, bir kaç eklenti yaparak istediğiniz yapılabilir.
 
Not:Aslında BrowserForFolder fonksiyonunu kullanacaktım ama bir hata verdi. Sorunu halen araştırıyorum. Şimdilik aşağıdaki kod(Necdet hocamın verdiği kod) işinizi görür sanırım.
Kod: 
Function DosyaAdiGetir()
    On Error Resume Next
    Dim i As Integer
    With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Show
    i = Application.WorksheetFunction.Find("\", StrReverse(.SelectedItems(1)))
    If i = 0 Then Exit Function
    DosyaAdiGetir = Left(.SelectedItems(1), Len(.SelectedItems(1)) - i + 1) & Right(.SelectedItems(1), i - 1)
    End With
End Function

Sub aktar()
    Set baglanti = CreateObject("ADODB.Connection")
    yol = "DRIVER={Microsoft Excel Driver (*.xls)};" & "DBQ=" & DosyaAdiGetir()
    baglanti.Open yol
    SAYFA = InputBox("SAYFAADI")
    Set rs = baglanti.Execute("[" & SAYFA & "$" & "a1:k1000" & "]")
    [a2].CopyFromRecordset rs
    rs.Close
    baglanti.Close
End Sub
 
Sayın Haluk'un verdiği kodları uygulamak istedim ama (versiyon farklılığından dolayı)hata verdi. Bu yüzden bu kodları kullanmanızı öneriyorum.
 
Size yardımcı olabileceğini düşündüğüm bilgiler;
Kod: 
‘Haluk bey’in kodları
Sub Test()
Dim objFolder As Object
Dim MyPath As String, MyFile As String
Set objFolder = CreateObject("Shell.Application").BrowseForFolder _
(0, "Klasör seçin...", &H4000, "C:\")
If Not TypeName(objFolder) = "Nothing" Then
MyPath = objFolder.Items.Item.Path
MyFile = objFolder.Items.Item.Name
End If
Set objFolder = Nothing
MsgBox "Dosya / Klasör yolu: " & MyPath & vbCrLf & vbCrLf & _
"Dosya / Klasör adı : " & MyFile
End Sub

Kod: 
‘Levent bey’in kodları

Sub test2 ()
ChDir "C:\belge"
dosya = Application.GetOpenFilename("Excel Dosyası (*.xls),*.xls", , "Excel Dosyasını Seçin")
MsgBox "Dosya / Klasör yolu: " & dosya & vbCrLf & vbCrLf & _
"Dosya / Klasör adı : " & Dir(dosya)
End Sub

Konuyla alakalı linkler
http://officetanaka.net/excel/vba/tips/tips39.htm
http://wsh2.uw.hu/ch12f.html

Kod: 
 ‘Zeki bey’in kodları
‘Referanslardan "Shell32.dll" dosyasını ekleyin. Aşağıdaki satırları test edin
Sub test3 ()
Dim s As New Shell32.Shell
x = s.BrowseForFolder(0, "test", 0)
MsgBox x
end sub
Kod: 
‘Sayın yurttas’ın kodları
Sub Test5()
Dim Adres As String
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.BrowseForFolder(&H0&, "Klasör Seçin", &H4001&, "")
If oFolder Is Nothing Then 
Exit Sub
Else
Set oFolderItem = oFolder.Self
Adres = oFolderItem.Path
End If
End sub
Kod: 
‘Zeki bey’in kodları

Sub Test6()
Set dlg = CreateObject("MSComDlg.CommonDialog")

'/Filter syntax: İsim |filtre|
strFilter = "Access dosyası (*.mdb)|*.mdb|"
strFilter = strFilter & "Excel dosyaları (*.xls)|*.xls|"
strFilter = strFilter & _
    "Resim dosyaları (*.bmp,*.jpg,*.gif)|*.bmp;*.jpg;*.gif|"
strFilter = strFilter & "Tüm dosyalar (*.*)|*.*|"

With dlg
    .DialogTitle = "Dosya seçiniz..." '/Başlık
    .InitDir = "C:\" '/Varsayılan konum
    .Flags = 4 '/Saltokunur seçeneği disable olur
    .Filter = strFilter
    .FilterIndex = 4 '/Yukarıdaki filtrelerin varsayılanı.(Tüm dosyalar)
    .ShowOpen
 If .Flags = 4 Then Exit Sub  '/İptal tuşuyla sonlandır
End With

MsgBox dlg.Filename
End Sub
‘Ben de verdiği hata
"ActiveX component can't create object"
http://support.microsoft.com/kb/296205
 
diğer çalışma kitabından veri aktarma için yazılmış kod hakk

hamitcan' Alıntı:
Kod: 
Sub aktar()
    Set baglanti = CreateObject("ADODB.Connection")
    yol = "DRIVER={Microsoft Excel Driver (*.xls)};" & "DBQ=" & ThisWorkbook.Path & "\veri.xls"
    baglanti.Open yol
    Set rs = baglanti.Execute("[veri$a1:k1000]")
    [a2].CopyFromRecordset rs
    rs.Close
    baglanti.Close
End Sub
şeklinde deneyin.
Genişletmek için tıkla ...

Sayın HAmitcan Bey;
bu yazdıgınız kodu inceledim. Aynı şekilde kullandım fakat başarılı olamadım. ekte sizden alarak eklediğim kod var. Acaba eklemem gereken bir kütüphanemi var çünkü variable not defined errorü veriyor koddaki baglantiyi variant diye tanıtmaya çalıştım fakat yinede başarılı olamadım bu konuda yardımcı olabilirmisiniz?
 

Ekli dosyalar

hamit Bey;
bu kod verideki aynı şekilde data ya aktarıyo. söyle birsey mümkünmü? verinin a1 de yazan sayı veya rakkamı datanın c1 ne yazmak gibi..benim asıl istediğim öyle birşey kodu çalıştırıp üzerinde deneyecektım başarılı olamadım. bu kod kararterler için çalışıyor fakat rakkamlar için görmüyor. benim kutularımda hem karakter hemde rakkam var bunu nasıl sağlayabilirim
 
Not:Sayıları, metin olarak girerseniz, düzgün aktarıyor.
Kod: 
Sub aktar()
    Set baglanti = CreateObject("ADODB.Connection")
    yol = "DRIVER={Microsoft Excel Driver (*.xls)};" & "DBQ=" & ThisWorkbook.Path & "\Veri.xls"
    baglanti.Open yol
    Set rs = baglanti.Execute("[Sayfa1$a:a]")
    [c3] = rs.Fields(0).Name
End Sub
 
çok teşekür ederim... Bu sadece karakterler için galibaa çunkü hala rakkamı görmüyor. a1 e 3 yazdıgımda data sayfasında f1 olarak gösteriyor
 
çok teşekür ederim... Bu sadece karakterler için galibaa çunkü hala rakkamı görmüyor. a1 e 3 yazdıgımda data sayfasında f1 olarak gösteriyor dediğiniz gibi hücre biçimi metin olarak sectim
 
Rakamın başına tırnak koyun yada metin olarak biçimlendirip rakamı tekrar girin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst