klasördeki istenen dosyadan veri alma

[zamenya]

Arkadaşlar merhaba ekte eklediğim yapmak istediğim çalışmada veriler klosöründe ocak,şubat ..... diye çalışma kitapları var,anamenüçalışma kitabında useruserformu açtığımda comboboxtan seçtiğim isimle veriler klosöründeki veileri alabilirmiyim veriler klosöründe alacağım çalışma kitaplarında N VE O sütünlarında formul var formülü bozmadan alamam gerekiyor.
bu konuda yardımcı olabilrmisiniz arkadaşlar

 

[cimbom05]

İyi günler sayın Zamenya
Buna benzer sorunumla ilgili foruma bir konu açmıştım. Froumdaki üstadlar tarafından ekli dosya oluşturulmuştur. İncelerseniz istediğinize çözüm olabilir.

 

[zamenya]

sayın cimbomb05 örneğinizi inceledim çok teşekkürederim ama bende ki verimiktarı çok fazla olduğu için teker teker seçip aktaramam toplu halde aktarması gerekiyor, ve diğer sayfalarında açılmadan aktarma imkanı yokmu veiler çok fazla olduğundan dolayı aktaracağım kitap açılırsa çok yavaşlıyor

 

[omerceri]

Private Sub CommandButton1_Click()
Workbooks.Open (ThisWorkbook.Path & "\veriler\" & ComboBox1)
Sheets("Sayfa1").Cells.Copy
Workbooks("anamenu.xls").Sheets("Sayfa1").Cells.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Workbooks(ComboBox1.Value).Close
End Sub

Private Sub UserForm_Layout()
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(ThisWorkbook.Path & "/veriler")
Set fc = f.Files
For Each f1 In fc
ComboBox1.AddItem f1.Name

Next
End Sub

 

[omerceri]

Kodları aşağıdaki gibi değiştirin
Private Sub CommandButton1_Click()
Workbooks.Open (ThisWorkbook.Path & "\veriler\" & ComboBox1)
Sheets("Sayfa1").Columns("A:O").Copy
Workbooks("anamenu.xls").Sheets("Sayfa1").Columns("A:O").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Workbooks(ComboBox1.Value).Close
End Sub

 

[zamenya]

arkdaşlar merhaba aşağıdaki kodla comboboxtaki seçtiğim kitaptaki verleri almaya çalışıyorum ama seçtiğim çalışma kitabından sonra klosörde bulunan diğer çalışmakitaplarındaki verileri de alıyor sadece seçtiğim kitabtaki verileri almak için nasıl uyarlaya blirim


kod.
Private Sub CommandButton13_Click()

Application.ScreenUpdating = False
Dosya_Yolu = "C:\çalışma\Veriler" & ComboBox1.Value
Set s1 = Workbooks("kullanıcı(1).xls").Sheets("veri")
s1.Select
[A2:k65536].ClearContents
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder("C:\çalışma\Veriler").Files
For Each dosya In Klasör
If InStr(dosya.Name, ".xls") > 0 Then
If dosya.Name <> "kullanıcı(1).xls" Then
Workbooks.Open Filename:=dosya
Sheets("VERİ").Select
Range("a2:a" & [a65536].End(3).Row).Copy s1.Cells(65536, 1).End(3).Offset(1)
Range("b2:b" & [b65536].End(3).Row).Copy s1.Cells(65536, 2).End(3).Offset(1)
Range("c2:c" & [c65536].End(3).Row).Copy s1.Cells(65536, 3).End(3).Offset(1)

Range("d2:d" & [d65536].End(3).Row).Copy s1.Cells(65536, 4).End(3).Offset(1)

Range("e2:e" & [e65536].End(3).Row).Copy s1.Cells(65536, 5).End(3).Offset(1)

Range("f2:f" & [f65536].End(3).Row).Copy s1.Cells(65536, 6).End(3).Offset(1)
Range("g2:g" & [G65536].End(3).Row).Copy s1.Cells(65536, 7).End(3).Offset(1)
Range("h2:h" & [h65536].End(3).Row).Copy s1.Cells(65536, 8).End(3).Offset(1)
Range("ı2:ı" & [ı65536].End(3).Row).Copy s1.Cells(65536, 9).End(3).Offset(1)
Range("j2:j" & [j65536].End(3).Row).Copy s1.Cells(65536, 10).End(3).Offset(1)
Range("k2:k" & [k65536].End(3).Row).Copy s1.Cells(65536, 11).End(3).Offset(1)

ActiveWorkbook.Close True
End If
End If
Next
Application.ScreenUpdating = True
CommandButton19_Click
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[zamenya]

lütfen yardım

 

[omerceri]

Eğer "K" Sütununa kadar almak istiyorsanız
Private Sub CommandButton1_Click()
Say = [a65536].End(3).Row
Workbooks.Open (ThisWorkbook.Path & "\veriler\" & ComboBox1)
Sheets("Sayfa1").Range("A1:K" & Say).Copy
Workbooks("anamenu.xls").Sheets("Sayfa1").Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Workbooks(ComboBox1.Value).Close
End Sub

 

[ziya]

Sn omerceri
Kodlarınızı uyguladım, uygulamanın pratik olup olmadığını test etmek için "Ocak" kitabını hem veri ile hem sayfa adedi ile şişirdim. 18 sayfa 10.000 satır sütun A:AA (kodlrı da AA yaptım) gayet güzel.
Kapalı kitaptan sayfa seçerek veri kaydetmek ve geri çağırmak olarak özetlenebilecek bir çalışmam var. ADO bilmiyorum, düşündüm "anamenü" diyebileceğimiz bir kitapta oluşturacağım bir "ara yüz" sayfası ile yapabilirim.
-Sayfa seçerek kayıt ve sayfa seçerek veri kopyalamayı kapsayacak şekilde kodlarınızı revize edebilirmisiniz.
Selamlar,

 

[zamenya]

sayın ömerceri kodları deniyorum amahata alıyorm

 

[zamenya]

sayın ömerceri hatayı nasıl düzletebilirim
Sheets("Sayfa1").Range("A1:K" & Say).Copy
Workbooks("anamenu.xls").Sheets("Sayfa1").Range("A 1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

 

[omerceri]

Bir yanlışlık vardım ama hata veremesi gerekiyor
Düzeltilimiş kodlarıda gönderiyorum.

Private Sub CommandButton1_Click()
Workbooks.Open (ThisWorkbook.Path & "\veriler\" & ComboBox1)
Say = [a65536].End(3).Row
Sheets("Sayfa1").Range("A1:K" & Say).Copy
Workbooks("anamenu.xls").Sheets("Sayfa1").Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Workbooks(ComboBox1.Value).Close
End Sub

 

[ziya]

Merhaba,
omerceri'nin ilk verdiği kodlar gayet güzel çalışıyor. Dört dörtlük.

Sn omerceri bir önceki sayfada 9 no.lu mesajımı okuma fırsatınız oldu mu.
Selamlar,