4 Aşamalı Dosya Aktarımı Nasıl Yapılır

[yorum.halil]

Arkadaşlar öncelikle kolay gelsin. Sizlere bir sorum olacak. Aynı satır ve hücrelere sahip bir excel dosyalarından verileri aktarmak istiyorum. Daha önce bu işlemi yapan bir dosya vardı. Fakat pc çöktüğü için o dosyaya erişemiyorum. Ekteki dosyaya göre anlatacak olursak Sizlerden isteğim kısaca şöyle. Nasıl bir vba kodu yazmalıyız ki aşağıdaki işlemi sırasına göre yapsın..

1- Merkez Dosyasına bir buton koyarak GÖZAT seçeneği ile istenen excel dosyasını seçeceğiz.

2- Daha sonra ile seçilen excel dosyasındaki verileri AKTAR.TXT isimli text dosyası ile excel dosyasının bulunduğu yere otomatik olarak oluşturulacak.

3- Daha sonra TXT dosyasındaki verileri MERKEZ isimli dosyaya aynı hücrelere otomatik olarak aktaracak

4- Son olarakta oluşturulan txt dosyası otomatik olarak silinecek.

Biliyorum belki enterasan yada zor bir şey istiyorum ama bunun imkansız olmadığını daha önce kullandığım dosyadan biliyorum. Burada önemli olan ufak bir ayrıntı direkt excel den excele veri atmayacak. Önce txt oluşturacak verileri oradan alacak..

Siz siz olun kullandığınız önemli dosyaların yedeğini almayı unutmayın. Şimdiden yardımlarınız için tşk. ederim.

 

[Levent Menteşoğlu]

Verileri neden text dosyasına alma gereği duyduğunuzu anlayamadım. ADO ile verileri kolaylıkla ana dosyaya alabilirsiniz. Aşağıdaki kodu MERKEZ isimli dosyanızda oluşturacağınız bir butona bağlayarak çalıştırın.

Sub verilerial()
dosya = Application.GetOpenFilename("Excel Dosyası (*.xls),*.xls", , "Veri Alınacak Dosyayı Seçin")
If dosya <> False Then
Set baglanti = CreateObject("ADODB.Connection")
yol = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dosya & ";Extended Properties=""Excel 8.0;HDR=no;IMEX=1"";"
baglanti.Open yol
Set rs = baglanti.Execute("[sayfa1$b2:g65536]")
[b2].CopyFromRecordset rs
rs.Close
baglanti.Close
End If
End Sub

 

[yorum.halil]

Verileri neden text dosyasına alma gereği duyduğunuzu anlayamadım. ADO ile verileri kolaylıkla ana dosyaya alabilirsiniz.

Üstad daha öncede bu konu ile ilgili olarak geçen sene yardım istediğimde bana aşağıdaki kodlama ile yapmam gerektiği söylendi. Ama veri alacağımız excel dosyasında 10 saniyelik user form olduğu için 10 saniyenin geçmesini bekleyip öyle veri aktarımı yapıyordu. Eğer dosya ismide aynı ise o zamanda hata veriyordu. Bu nedenle böyle bir çözüm istedim.

Fakat sizin verdiğiniz kodları kullandığım zaman direkt verileri alıyor.. User form falan çalışmıyor...yani bu şekilde gayet kullanışlı oldu. Elinize emeğinize sağlık..

GEÇEN SENE VERİLEN KOD

Sub VERIAKTAR1()
ad = ThisWorkbook.Name
Range("C5:S204").ClearContents
Application.ScreenUpdating = False
dosya = Application.GetOpenFilename("Excel Dosyası (*.xls),*.xls", , "Hedef Dosyayı Seçin")
If dosya = False Then Exit Sub
Workbooks.Open Filename:=dosya
Sheets(3).Select
sonsat = ActiveWorkbook.ActiveSheet.Cells(65536, "C").End(xlUp).Row
If sonsat < 2 Then Exit Sub
adrs = Range(Cells(5, "C"), Cells(sonsat, "S")).Address
Workbooks(ad).Sheets(3).Range(adrs).Value = ActiveWorkbook.ActiveSheet.Range(adrs).Value
ActiveWorkbook.Close False
Application.ScreenUpdating = True
MsgBox "Aktarım tamamlandı", vbOKOnly + vbInformation, "Dikkat"
Range("C5").Select
Dim cb As CommandBar
Application.DisplayFormulaBar = False
For Each cb In Application.CommandBars
cb.Enabled = False
Next cb
With ActiveWindow
.DisplayHeadings = False
.DisplayOutline = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
End With
End Sub

http://www.excel.web.tr/showthread.php?t=42334&highlight=G%F6zat