Kapalı dosyadan CSV dosyasına istenen sütunları çekmek.

[Filose]

Herkese merhaba,

Kapalı olan AAA Dosyasında bulunan sütunların bazılarını 2. satırından başlayarak Aşağıya doğru dosya adı olan BBB.csv dosyasının 2. satırından başlayarak dökmek istiyorum.

Yapmak istediğim örnekle alakalı bir kaç örnek yaptım. Ancak CSV dosyasına çekmeyi beceremedim.

Ekte bulunan dosyada ayrıntı vardır. Herkese teşekkür eder ellerine sağlık.

 

[Filose]

Yardımcı olabilecek arkadaş var mı acaba? Yapmak istediğim aslında hiç karışık değil.

Örnek dosyada görüleceği üzere; kapalı dosyanın B2, C2, D2, E2 ve I2 sütunlarındaki verileri csv uzantılı dosyamın istediğim sütuna aşağıya doğru yazabileyim.

Bunu yaptım ancak istediğim sütuna dökemedim. sütun adreslerini ben değiştirebileyim diye istiyorum. Herkese teşekkür eder saygılar sunarım.

 

[Filose]

Kapalı dosyadan A2 sütunundan başla aşağıya doğru açık olan dosyanın A2 sütununa yazsın. Ben sütun ekleyip çıkarabilirim. Tekrar teşekkürler.

 

[Ömer BARAN]

Merhaba.

Verilerin yazılacağı belgeyi (BBB.csv) açın, ALT+F11 tuşlarına basın,
boş bir modül'e aşağıdaki kod'u yapıştırın ve çalıştırın.

[FONT="Arial Narrow"][B][COLOR="blue"]Sub VERİ_AL_BRN()[/COLOR][/B]
Application.ScreenUpdating = False
yol = ThisWorkbook.Path & "\AAA.xls"
Workbooks.Open (yol)
For sütun = 2 To 8
    If sütun > 4 Then
        sut = sütun + 1
        ElseIf sütun < 4 Then
            sut = sütun - 1
        ElseIf sütun = 4 Then
        sut = sütun
    ElseIf sütun = 3 Then GoTo 10
End If

Workbooks("AAA.xls").Activate
ilk = ActiveWorkbook.Sheets("Sheet").Cells(2, sütun).Address
son = ActiveWorkbook.Sheets("Sheet").Cells(ActiveWorkbook.Sheets("Sheet").Cells(65536, _
        sütun).End(3).Row, sütun).Address
ActiveWorkbook.Sheets("Sheet").Range(ilk & ":" & son).Copy
Workbooks("BBB.csv").Activate
Cells(2, sut).Select: ActiveSheet.Paste
10: Next
Workbooks("AAA.xls").Close True: Cells(1, 1).Activate: Application.ScreenUpdating = True
MsgBox "BİTTİ"
[B][COLOR="blue"]End Sub[/COLOR][/B][/FONT]

 

[Ömer BARAN]

Mükerrer cevabı sildim. Bir önceki cevabıma bakınız.

 

[Filose]

Ömer Bey ellerin dert görmesin çok teşekkür ederim. Tam istediğim gibi oldu ben çeşitli amaçlarla değişiklik yapabilirim.

Aktarılan satırlar genelde maksimum 1000 cıvarında oluyor. Bu nedenle bellek dolu boşaltayım mı diyor. Evet deyince sorun yok aktarma yapıyor. Bu durum giderilebiliyor mu? Birde aktarma biraz yavaş neden acaba?

Tekrar teşekkür eder sağılar sunarım.

 

[Ömer BARAN]

Tekrar merhaba.

Kod'da yer alan 10:Next satırından bir önceki satırın sonuna (aradaki : işaretini unutmayın)
mavi kısmı eklerseniz sorun kalmaması gerekir.
.

[FONT="Arial Narrow"]Cells(2, sut).Select: ActiveSheet.Paste[COLOR="Blue"][B] : Application.CutCopyMode = False[/B][/COLOR][/FONT]

 

[Filose]

Ömer Bey merhaba,

Her şey tamam sorun yok. Dosyam CSV olduğundan bunu eklenti yapıp buton ekleyeceğim. Sorun olmaz sanırım.

Tekrar teşekkür eder saygılar sunarım.

 

[Tevfik_Kursun]

Merhaba Ömer Hocam,
Öncelikle ilginiz için teşekkür ederim.
Aynı dosya farklı şekillerde de kullanılabilir. Bu nedenle yazılan makroyu ihtiva eden dosya, bilgileri farklı bir dosyaya (ccc.csv) çekip onu csv olarak kaydetse daha iyi olabilir.
Bu vesileyle ben de aynı makroyu kullanabilirim.
Saygılarımla