Verileri bölüp ayrı çalışma kitabı olarak kaydetme hk

[semitic]

Sayın,

Yaklaşık 20.000 satırlık bir verim var, bu veriyi bir sutünundaki değerlere göre parça parça ayrılıp, ayrılan değer adında yeni bir çalışma kitabı olarak kaydedilmesi.

Örneğin, ad-soyad-doğum yeri-doğum yılı bilgilerini içeren 20.000 kayıtlı veride doğum yerine göre her bir doğum yeri için dosyaları ayrı ayrı kaydetme. Doğum yeri Ankara olanları ayırıp Ankara isimli ... klasör içine kaydedilmesi. Diğer iller içinde aynı işlemi tekrar yapmalı.

Saygılarımla,

 

[Necdet]

Merhaba,

Sorunuzu örnek dosya ile destekler misiniz?

 

[semitic]

Ekteki dosyaya göre Kod 1 sütunu içerisindeki değerlere görekendilerine ait bilgiler ayrı ayrı yeni çalışma kitabına kaydedilmesi.


Kod 1 sütunundaki veri çeşitliliği
1003
1005
1009
1064
1111
1133

 

[semitic]

Necdet bey,

Örnek isimli dosya örnek olabildi mi? İşlem mümkün değil midir?

Saygılarımla,

 

[Necdet]

Merhaba,

Hangi sütuna göre dosya oluşturacak?

 

[semitic]

Merhabalar,

Kod 1 bilgileri örnek dosyada Sütun B'dedir. Örnek dosyaya göre 6 adet dosya oluşması lazım.
1003
1005
1009
1064
1111
1133

 

[Necdet]

Dosyaya Ayırma

Merhaba,

Ekteki dosyanın C:\Veri altında ve Adınında _Ornek.xls olması gerek. Siz gerekirse Dosya yolunu değiştirebilirsiniz.

Sub Baska_Dosyaya_Yaz()
Application.ScreenUpdating = False
Dim SonSat, Bas_Sat, Son_Sat As Long
Dim SonCol As Integer
Dim Dosya_Ad As String
SonSat = [A65536].End(3).Row + 1
SonCol = [IV1].End(1).Column
Range(Cells(2, "A"), Cells(SonSat - 1, SonCol)).Sort Key1:=[B2]
Dosya_Ad = [B2]
Bas_Sat = 2
Son_Sat = 0
For i = 2 To SonSat
    If Cells(i, "B") <> Dosya_Ad Then
        Son_Sat = i - 1
        Set NewBook = Workbooks.Add
            With NewBook
                .Title = "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
                .Subject = "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
                .SaveAs Filename:="C:\Veri\" & Dosya_Ad & ".xls"
            End With
            ActiveWorkbook.Close True
        Workbooks.Open Filename:="C:\Veri\" & Dosya_Ad & ".xls"
        
        Windows("_Ornek").Activate
        Range(Cells(1, "A"), Cells(1, SonCol)).Select
        Selection.Copy
        Windows(Dosya_Ad).Activate
        Sheets(1).Range("A1").Select
        ActiveSheet.Paste
        Windows("_Ornek").Activate
        Range(Cells(Bas_Sat, "A"), Cells(Son_Sat, SonCol)).Select
        Selection.Copy
        
        Windows(Dosya_Ad).Activate
        Sheets(1).Range("A2").Select
        ActiveSheet.Paste
        
        
        ActiveWorkbook.Close True
        
        Bas_Sat = i
        
        Dosya_Ad = Cells(i, "B")
        
    End If
    
Next i
[A1].Select
MsgBox "Dosya Ayırma İşi Tamamlanmıştır...."
End Sub

 

[semitic]

Necdet bey, öncelikle teşekkürler, ekteki dosyanızı C'nin altında Veri isminde klasör oluşturup, kopyaladım, Butona bastığımda 1003 isimli dosya belge oluştu ama içi boş ve hata mesajı verdi, ekte hatanın ekran görüntüsünü gönderiyorum. Syg,

 

[Necdet]

Merhaba,
Sayın semitic, defalarca denedim bende hata vermedi.

Acaba başka arkadaşlarda da aynı hata oluştu mu merak ettim şimdi.

 

[semitic]

Necdet bey, burada bir başka arkadaşın bilgisayarında denedim aynı hata mesajını verdi. Neden olabilir?

 

[Necdet]

Merhaba,

Dosyayı dener misiniz?

 

[semitic]

Günaydın,

Maalesef aynı hatayı vermekte.

 

[Necdet]

Günaydın,

Bir anlam veremiyorum, işyerinde 3 bilgisayarda denedim hepsinde çalıştı.

C:\Veri dizinini büyükharfle yazmış olmayasınız.

 

[semitic]

Necdet bey, uğraşınız için teşekkürler, ekte ekran görüntüsünü gönderiyorum, C'nin dizilimi gönderdiğiniz gibi, bilgisayarımda excel açılırken Hyperion isimli bir program eklentisi de açılıyor, yani ilk önce Kitap 1 diye boş dosya sonra açmak istediğiniz dosya açılıyor. Bu neden olabilir mi?
Dün bunu düşünerek işyerimde bu programın olmadığı arkadaşta denemiştim aynı hatayı vermişti. Aklıma başka bir şey gelmiyor.
Eğer olmaz ise nasip artık. Saygılarımla,

 

[Necdet]

Sayın semitic,

İnanın bir yorum yapamıyorum, burayı ziyaret eden ustalardan ya da üyelerden de pek bir yorum gelmiyor.

İşin garibi hadi kendi bilgisayarımı boşverin işyerinde 3 değişik bilgisayarda denedim hiç sorun çıkmadı.

Dosyayı olduğu gibi kullanıyorsunuz değil mi? herhangi bir değişiklik yapmadan yani.

 

[Orion1]

Necdet bey dosyaların uzantılarını yazmadığınız için hata veriyor.
bu durumu düzeltirseniz dosya çalışacaktır sanırım.

 

[semitic]

Necdet bey, gönderdiğinizi oynamadan C:\Veri altına aldıktan sonra dosyayı açıp yaptığınız butona basıyorum ve dünkü hata mesajı geliyor?

 

[Necdet]

Evren Bey,
Dosya adlarında uzantıları var, Window da uzantı yok. Benim anlamadığım bende nasıl çalışıyor hemde şakır şakır.

 

[semitic]

Necdet bey, Windows uzantı eklenmesini nasıl yapabilirim veya eklenmiş halini gönderebilir misiniz? Birde böyle deneyelim.

 

[Korhan Ayhan]

Selamlar,

Sn. Necdet beyin eklemiş olduğu dosyayı bende denedim ve problem ile karşılaşmadım.