çalışma sayfasınan, çalışma kitapları oluşturma hakkında yardımcı olabilir misiniz?

[cenk_139]

arkadaşlar merhaba,

eklediğim örnek dosyadaki tablodan lokasyon2 sütunundaki verilere göre farklı çalışma kitapları olşuturmam gerekiyor. her bir lokasyon için farklı bir çalışma kitabı oluşturacağım başlıklar tüm çalışma kitaplarında olacak. Örneğin 4001,4087 için ayrı excel ller oluşturacağım ancak işin içinden çıkamıyoruz yardımcı olabilir misiniz?

teşekkürler.

 

[mancubus]

hazır ücretsiz bir add-in var bunun için:

http://www.datapigtechnologies.com/freeware.htm

Excel Explosion 3.0 tıklayın ve zip'li dosyayı indirin.
zip dosyasının üzerinde tıklayın ve açın. içinde setup.exe dosyası var.
tıklayın ve komutları takip edin. (I accept.... seçeneğini işaretlemeyi unutmayın.)

bilgisayarda C'nin altında DPEE adında bir klasör oluşturacak ve dosyaları buraya çıkaracak.

excel'de iken eklentiler'den bu klasördeki datapigee.xla eklentisini ekleyin.

çalıştırın.
açılan formda;
Step1'de tabloyu mouse ile seçin. veya sizin örnek için el ile A1:G1827 yazın.
Step2'de filtre uygulanacak sütunu seçin. sizin örnek için B sütunu üzerinde tıklayın.
Step3'te parçalanmanın nasık olacağını seçin. aynı dosya içinde yeni sayfalar mı (üstteki) yoksa her biri için ayrı dosya mı (alttaki)? sizin örnekte ikinci seçenek.
bunun hemen altında yeni dosyaların hangi klasörde olacağı var. tıklayarak bir klasör seçin.
enter a description of data'ya dosyalar için bir tanım yazın. bu ifade oluşturulacak dosyalara isim olarak eklenecek. örneğin: "proje" yazalım. 4001-proje.XLS, 4002-proje.XLS gibi isimler olacak.

 

[cenk_139]

çok teşekkür ederim, yeni bakma fırsatım ldu gerçekten müthiş bir makro ne kadar teşekkür etsem azdır

oluşturdukları sayfalarda ilk satırı boş bırakıyor bunu bırakmamasını sağlayabiliyor muyuz? biraz fazla oldum galiba ama

hazır ücretsiz bir add-in var bunun için:

http://www.datapigtechnologies.com/freeware.htm

Excel Explosion 3.0 tıklayın ve zip'li dosyayı indirin.
zip dosyasının üzerinde tıklayın ve açın. içinde setup.exe dosyası var.
tıklayın ve komutları takip edin. (I accept.... seçeneğini işaretlemeyi unutmayın.)

bilgisayarda C'nin altında DPEE adında bir klasör oluşturacak ve dosyaları buraya çıkaracak.

excel'de iken eklentiler'den bu klasördeki datapigee.xla eklentisini ekleyin.

çalıştırın.
açılan formda;
Step1'de tabloyu mouse ile seçin. veya sizin örnek için el ile A1:G1827 yazın.
Step2'de filtre uygulanacak sütunu seçin. sizin örnek için B sütunu üzerinde tıklayın.
Step3'te parçalanmanın nasık olacağını seçin. aynı dosya içinde yeni sayfalar mı (üstteki) yoksa her biri için ayrı dosya mı (alttaki)? sizin örnekte ikinci seçenek.
bunun hemen altında yeni dosyaların hangi klasörde olacağı var. tıklayarak bir klasör seçin.
enter a description of data'ya dosyalar için bir tanım yazın. bu ifade oluşturulacak dosyalara isim olarak eklenecek. örneğin: "proje" yazalım. 4001-proje.XLS, 4002-proje.XLS gibi isimler olacak.

 

[mancubus]

rica ederim.

add-in parola korumalı olduğu için, parolayı bilmeden, (yasal yollardan) kodlarda değişiklik yapma şansı yok.

 

[mancubus]

tüm dosyalardaki 1. satırları silmek için aşağıdaki gibi bir kod ayrıca kullanılabilir.

Sub KlasordekiTumDosyalardanSatirSil()

    Dim klasör As String
    Dim dosyalar As String
    
    klasör = "C:\Users\Dosyalar" 'oluşturulan dosyaların bulunduğu klasör adı tam yolu ile yazılacak
    dosyalar = Dir(klasör & "\*.xlsx")
    
    Do While dosyalar <> ""
        Workbooks.Open Filename:=klasör & "\" & dosyalar
        With ActiveSheet 'veriler yeni oluşturulan dosyalar açıldığında görünen sayfada olduğu için activesheet
            If .Range("A1") = "" Then .Rows(1).Delete 'A1 hücresi boş ise 1. satırı sil
        End With
        ActiveWorkbook.Close True
[COLOR="Red"][B]        dosyalar = Dir[/B][/COLOR]
    Loop

End Sub

 

[cenk_139]

teşekkür ederim, nacak bu kodda hata veriyor sanırım oluşturduğu dosyaların adı sıraya olmadığı için ikinci dosyaya geçmiyor. kodu şöyle yaptık ama yine hata veriyor, burada bir sonraki dosya adını kontrol kontrol etmemiz gerekiyor ama bir noktada kaldık nasıl bir yol izlemeliyiz?

kodu şu hale getirdik son hali ile;

Sub KlasordekiTumDosyalardanSatirSil()

Dim klasör As String
Dim dosyalar As String
Dim dosya As String
dosya = 4001

Do While dosya < "5000"
klasör = "C:\Documents and Settings\cenkkoca\Desktop\örnek 1\" 'oluşturulan dosyaların bulunduğu klasör adı tam yolu ile yazılacak
dosyalar = Dir(klasör & dosya & ".xlsx")
Workbooks.Open Filename:=klasör & "\" & dosyalar
With ActiveSheet 'veriler yeni oluşturulan dosyalar açıldığında görünen sayfada olduğu için activesheet

If .Range("A1") = "" Then .Rows(1).Delete 'A1 hücresi boş ise 1. satırı sil
End With
ActiveWorkbook.Close True
dosya = dosya + 1
Loop

End Sub

tüm dosyalardaki 1. satırları silmek için aşağıdaki gibi bir kod ayrıca kullanılabilir.

Sub KlasordekiTumDosyalardanSatirSil()

    Dim klasör As String
    Dim dosyalar As String
    
    klasör = "C:\Users\Dosyalar" 'oluşturulan dosyaların bulunduğu klasör adı tam yolu ile yazılacak
    dosyalar = Dir(klasör & "\*.xlsx")
    
    Do While dosyalar <> ""
        Workbooks.Open Filename:=klasör & "\" & dosyalar
        With ActiveSheet 'veriler yeni oluşturulan dosyalar açıldığında görünen sayfada olduğu için activesheet
            If .Range("A1") = "" Then .Rows(1).Delete 'A1 hücresi boş ise 1. satırı sil
        End With
        ActiveWorkbook.Close True
    Loop

End Sub

 

[mancubus]

bir satır eksik kopyalamışım buraya.

mesajda ekledim.