• DİKKAT

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

Makro ile excel kitaplarından veri alma

M

muratanya

Katılım
16 Haziran 2008
Mesajlar
2
Excel Vers. ve Dili
TÜRKÇE
Merhaba arkadaşlar, elimde kontrol kartları adlı klasör içerisinde farklı adları olan 4500 adet veri girişleri yapılmış birbirinin aynı tabloların kullanıldığı excel kitapları var. Bu 4500 adet excel kitabının son sayfasından sadece belli hücrelerdeki verileri çekip yeni bir sayfada listeleyecek bir makro varmıdır,verilerin çekileceği hücreler (B4,B5,G4,H4,I4,C7 VE C21-C22-C23-.............-C37), yardımcı olabilecek,arkadaşlara şimdiden teşekkürler..
 
Son düzenleme:
muratanya' Alıntı:
Merhaba arkadaşlar, elimde kontrol kartları adlı klasör içerisinde farklı adları olan 4500 adet veri girişleri yapılmış birbirinin aynı tabloların kullanıldığı excel kitapları var. Bu 4500 adet excel kitabının son sayfasından sadece belli hücrelerdeki verileri çekip yeni bir sayfada listeleyecek bir makro varmıdır,verilerin çekileceği hücreler (B4,B5,G4,H4,I4,C7 VE C21-C22-C23-.............-C37), yardımcı olabilecek,arkadaşlara şimdiden teşekkürler..
Genişletmek için tıkla ...


Ekli dosyayı masa ustune kopyalayıp Ab1 hücresine benim yazdığım gibi dosyaların bulunduğu klasörün adresini yazın ve makroyu çalıştırın.
 

Ekli dosyalar

hüseyin bey cevap için teşekkürler ama makroyu çalıştıramadım.. formülasyona tekrardan bakabilirseniz sevinirim..
 
muratanya' Alıntı:
hüseyin bey cevap için teşekkürler ama makroyu çalıştıramadım.. formülasyona tekrardan bakabilirseniz sevinirim..
Genişletmek için tıkla ...

Dosyayı test etmiştim dosya alışıyor sizin excel dosyalarınızın olduğu klasorun yolunu ve uzantılarını paylaşırmısınız.. eğer 2007 ve ustu excelde hazırlanmışsa dosyalar kodun içerisindeki

Dosya = Dir(Yol & "*.xls") xls uzantısını sizin dosyaların uzantısı ile değiştirin .xlsx gibi.
 
Son düzenleme:
Mehmet Bey merhaba bir excel dosyasından başka bir excel dosyasına kopyalama yapmak istiyorum.Verdiğiniz makroyu çalıştırdım.Benim içinde bir makro yazarmısınız?Örnek dosya ektedir.
 

Ekli dosyalar

bir excel dosyasından başka bir excel dosyasına kopyalama yapmak istiyorumÖrnek dosya ektedir.Yardımlarınız için şimdiden teşekkür ederim.
 

Ekli dosyalar

kemalist' Alıntı:
bir excel dosyasından başka bir excel dosyasına kopyalama yapmak istiyorumÖrnek dosya ektedir.Yardımlarınız için şimdiden teşekkür ederim.
Genişletmek için tıkla ...

bu konu baslığı altındaki Mehmet Bey kim bilmiyorum ama ben yardımcı olayım..


Aşağıda yol kısmında benim bilgisayardaki tanımlı alan var sizin Test dosyanız hangi klasörde ise o klasörün yerini benim yazdığım şekilde yazın ve çalışma sayfası dosyasından kodları çalıştırın.
Kod: 
Sub Veri_Al()
    Dim Yol As String, Dosya As String
    Dim K2 As Workbook
    On Error Resume Next
    Yol = "C:\Users\Huseyin\Desktop\Yeni klasör\"
    Dosya = Dir(Yol & "Test.xlsm")
    sonsat = Sheets("Sayfa1").Range("A65536").End(3).Row + 1
    Set K2 = Workbooks.Open(Yol & Dosya, False, False)
    Windows("Çalışma Sayfası.xlsm").Activate
    Sheets("Sayfa2").Cells(4, 2).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(7, 3).Value
    Sheets("Sayfa2").Cells(7, 4).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(11, 5).Value
    Sheets("Sayfa2").Cells(8, 4).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(11, 5).Value
    Sheets("Sayfa2").Cells(9, 4).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(11, 5).Value
    Sheets("Sayfa2").Cells(2, 6).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(4, 7).Value
    Sheets("Sayfa2").Cells(2, 7).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(4, 7).Value
    Sheets("Sayfa2").Cells(2, 8).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(4, 7).Value
    Sheets("Sayfa2").Cells(2, 9).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(4, 7).Value
    Sheets("Sayfa2").Cells(12, 3).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(8, 11).Value
    Sheets("Sayfa2").Cells(10, 6).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(8, 11).Value
    Sheets("Sayfa2").Cells(8, 8).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(8, 11).Value
    Sheets("Sayfa2").Cells(5, 10).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(8, 11).Value
    K2.Close True
End Sub
 
Merhaba Hüseyin bey ilginize teşekkür ederim.Benim yapmak istediğim sayfa1 ile sayfa2 arasında değil test dosyası ile çalışma sayfası isimli dosyanın hem sayfa1 e hem de sayfa2 ye kopyalama yapmakdı.satır eklemekte istemiyorum
 
kemalist' Alıntı:
Merhaba Hüseyin bey ilginize teşekkür ederim.Benim yapmak istediğim sayfa1 ile sayfa2 arasında değil test dosyası ile çalışma sayfası isimli dosyanın hem sayfa1 e hem de sayfa2 ye kopyalama yapmakdı.satır eklemekte istemiyorum
Genişletmek için tıkla ...

Kodlar zaten text dosyasından verileri alıyor sadece sayfa1'e kopyalama yapmıyordu onuda ekledim bir kontrol edermisiniz.

Birde bu konu başlığındaki mehmet bey kim?
Kod: 
Sub Veri_Al()
    Dim Yol As String, Dosya As String
    Dim K2 As Workbook
        On Error Resume Next
    Yol = "C:\Users\Huseyin\Desktop\Yeni klasör\"
    Dosya = Dir(Yol & "Test.xlsm")
    sonsat = Sheets("Sayfa1").Range("A65536").End(3).Row + 1
    Sheets("Sayfa1").Range("A1:O392").ClearContents
    Set K2 = Workbooks.Open(Yol & Dosya, False, False)
    Windows(Dosya).Activate
    Sheets("Sayfa1").Select
    Workbooks(Dosya).Sheets("Sayfa1").Range("A1:O392").Copy
    Windows("Çalışma Sayfası.xlsm").Activate
    Sheets("Sayfa1").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Sayfa2").Select
    Sheets("Sayfa2").Cells(4, 2).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(7, 3).Value
    Sheets("Sayfa2").Cells(7, 4).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(11, 5).Value
    Sheets("Sayfa2").Cells(8, 4).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(11, 5).Value
    Sheets("Sayfa2").Cells(9, 4).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(11, 5).Value
    Sheets("Sayfa2").Cells(2, 6).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(4, 7).Value
    Sheets("Sayfa2").Cells(2, 7).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(4, 7).Value
    Sheets("Sayfa2").Cells(2, 8).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(4, 7).Value
    Sheets("Sayfa2").Cells(2, 9).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(4, 7).Value
    Sheets("Sayfa2").Cells(12, 3).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(8, 11).Value
    Sheets("Sayfa2").Cells(10, 6).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(8, 11).Value
    Sheets("Sayfa2").Cells(8, 8).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(8, 11).Value
    Sheets("Sayfa2").Cells(5, 10).Value = Workbooks(Dosya).Sheets("Sayfa1").Cells(8, 11).Value
    K2.Close True
End Sub
 
Son düzenleme:
Hüseyin Bey diye yazacakken Mehmet Bey yazmışım özür dilerim.
 
Sub A_Dosyasından_B_Dosyasına_Kayıt()
'BU dosyaların açık olması lazım.
Workbooks("ALERTER1.0.xlsm").Sheets("yds").Range("O8:P381").Copy _
Workbooks("KAYIT.xlsm ").Sheets("Sayfa2").Range("F1")

MsgBox "İŞLEM TAMAM"
End Sub
Bu kod xls uzantılı dosyalardaçalışıyor fakat neden xlsm uzantılı dosyalarda çalışmıyor?
 
Aşağıdaki Şekilde denermisiniz.

Kod: 
Workbooks("ALERTER1.0.xlsm").Sheets("yds").Range("O8:P381").Copy _
destination:=Workbooks("KAYIT.xlsm").Sheets("Sayfa2").Range("F1")
 
sayın hüseyin "İŞLEM TAMAM" teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst