Spesifik Veri İçeren Satıları Ayrı Bir Dosyada Toplama

[sijwocaq]

Herkese Merhabalari

Forumda konu ile ilgili arama yaptım ama ihtiyacıma cevap verecek bir tartışma göremedim. İhtiyacım kısaca şöyle:

Temel düzeyde VBA’e hakimim. Fakat ihtiyacım olan şeyi bir türlü çözemedim. Öncelikle personel listesini içeren bir ana tablom var . İlk 6 satırı aynı başlıkları içerecek şekilde, bu personelleri (ana tabloda C sütununda yer alan) departmanlarına göre farklı Excel dosyalarına ayıran bir makroya ihtiyacım var.
Yani macro ana listede önce benim belirlediğim departman isimlerine sahip satırları alacak, yeni bir Excel dosyasının 7. Satırından itibaren bu satırları arka arkaya yapıştıracak. İlk 6 satırı kaplayan headerı kopyalamasa da olur. O satırları ben daha sonra manuel olarak kopyalayıp yapıştırırım dosyalara. Ama en azından başka Excel dosyasına olmasa bile yeni bir sheet’e, belirlediğim departmanlara göre ayırabilse şahane olur.

Bu arada personel sayısı her ay değişmekle birlikte departmanlar sabit kalıyor.

İlgilenen herkese şimdiden teşekkürler.

 

[asi_kral]

Merhaba
Dosya ekleme imkanınız var mı_?
İçinde açıklama eklerseniz yardımcı olmaya çalışırım.

 

[sijwocaq]

Selamlar,

Dosya ekledim. Teşekkürler.

 

[asi_kral]

Selamlar,

Dosya ekledim. Teşekkürler.

Merhaba
Kodu dener misiniz_?

Option Explicit
Sub sayfa_olarak_ayır()
Dim SAT As Long, AD As String, TAM As Long, SAY As Long
Dim S1 As Worksheet, S2 As Worksheet, AÇ As Variant, HATA
Set S1 = Sheets("Data")
With WorksheetFunction
TAM = S1.Cells(Rows.Count, "A").End(xlUp).Row
For SAT = 2 To TAM
If .CountIf(S1.Range("C2:C" & SAT), S1.Cells(SAT, "C")) = 1 Then
AD = S1.Cells(SAT, "C")
Sheets("BASLIK").Copy after:=Sheets(Sheets.Count)
AÇ = ActiveCell.Address
Sheets(Sheets.Count).Name = AD
Set S2 = Sheets(AD)
S1.Range("A1:C" & TAM).AutoFilter field:=3, Criteria1:=AD
S1.Range("A2:N" & TAM).Copy
S2.Range("A6").PasteSpecial (xlPasteValues)
S1.Range("A1:C" & TAM).AutoFilter
Range(AÇ).Select
S1.Select
End If: Next: End With
MsgBox "İşlem Tamamlandı", vbInformation
End Sub

Kodu ikinci defa çalıştırdığınızda hata verecektir. Bunun sebebi sayfaları açtığından aynı sayfalar aynı kitapta yer alamayacağı için.

 

[sijwocaq]

Merhaba
Kodu dener misiniz_?

Option Explicit
Sub sayfa_olarak_ayır()
Dim SAT As Long, AD As String, TAM As Long, SAY As Long
Dim S1 As Worksheet, S2 As Worksheet, AÇ As Variant, HATA
Set S1 = Sheets("Data")
With WorksheetFunction
TAM = S1.Cells(Rows.Count, "A").End(xlUp).Row
For SAT = 2 To TAM
If .CountIf(S1.Range("C2:C" & SAT), S1.Cells(SAT, "C")) = 1 Then
AD = S1.Cells(SAT, "C")
Sheets("BASLIK").Copy after:=Sheets(Sheets.Count)
AÇ = ActiveCell.Address
Sheets(Sheets.Count).Name = AD
Set S2 = Sheets(AD)
S1.Range("A1:C" & TAM).AutoFilter field:=3, Criteria1:=AD
S1.Range("A2:N" & TAM).Copy
S2.Range("A6").PasteSpecial (xlPasteValues)
S1.Range("A1:C" & TAM).AutoFilter
Range(AÇ).Select
S1.Select
End If: Next: End With
MsgBox "İşlem Tamamlandı", vbInformation
End Sub

Kodu ikinci defa çalıştırdığınızda hata verecektir. Bunun sebebi sayfaları açtığından aynı sayfalar aynı kitapta yer alamayacağı için.

Öncelikle ilginiz için çok teşekkür ederim. Kod gayet güzel çalışıyor. Yalnız tek sorun her departman için ayrı olarak sheet yaratıyor. Benim kodun içinde belirteceğim iki-üç farklı departmanı aynı sheet'e toplamak mümkün olabilir mi?. Bu örnek üzerinden gidersek, Özel Satışlar ve Personel Özlük İşlerini aynı sheet'e toplamak mümkün müdür?

 

[asi_kral]

Öncelikle ilginiz için çok teşekkür ederim. Kod gayet güzel çalışıyor. Yalnız tek sorun her departman için ayrı olarak sheet yaratıyor. Benim kodun içinde belirteceğim iki-üç farklı departmanı aynı sheet'e toplamak mümkün olabilir mi?. Bu örnek üzerinden gidersek, Özel Satışlar ve Personel Özlük İşlerini aynı sheet'e toplamak mümkün müdür?

Bunlardan başka var mı_?
Bir de bir sayfaya 3 kriterli veri alacak mısınız_?
Mesela Özel Satışlar - Pazarlama - Personel ve Özlük İş gibi...

 

[sijwocaq]

Bunlardan başka var mı_?
Bir de bir sayfaya 3 kriterli veri alacak mısınız_?
Mesela Özel Satışlar - Pazarlama - Personel ve Özlük İş gibi...

Başka departmanlar da var ama ben onları sonra elle eklerim diye düşündüm. Bir sheet'de 4-5 hatta 7 farklı departman olabilir.

 

[asi_kral]

Başka departmanlar da var ama ben onları sonra elle eklerim diye düşündüm. Bir sheet'de 4-5 hatta 7 farklı departman olabilir.

Bunları bir şekilde ayırt etmemiz gerekiyor. Ben koda ikincisini ilave etseydim siz üçüncüsünü ilave edemeyecektiniz kodda değişiklik olması gerekiyor 3 ve üstünde.

En iyisi ben size hem 2'liye örnek bir kod yazayım. Hem de 3 ve üstü için kod yazayım siz ona göre düzenleyin. Aklıma gelen en mantılı çözüm bu

Bir de sayfa adları nasıl olacak ikili veya üçlüde onuda söylerseniz yardımcı olmaya çalışayım

 

[sijwocaq]

Bunları bir şekilde ayırt etmemiz gerekiyor. Ben koda ikincisini ilave etseydim siz üçüncüsünü ilave edemeyecektiniz kodda değişiklik olması gerekiyor 3 ve üstünde.

En iyisi ben size hem 2'liye örnek bir kod yazayım. Hem de 3 ve üstü için kod yazayım siz ona göre düzenleyin. Aklıma gelen en mantılı çözüm bu

Bir de sayfa adları nasıl olacak ikili veya üçlüde onuda söylerseniz yardımcı olmaya çalışayım

Siz şimdilik ayrı ayrı yazmaya zahmet etmeyin. Ben size liste kesinleştiğinde tüm departmanları ve olması gereken grupları gösteren bir liste atarım. Ne yapabileceğimize öyle bakarım.

 

[asi_kral]

Siz şimdilik ayrı ayrı yazmaya zahmet etmeyin. Ben size liste kesinleştiğinde tüm departmanları ve olması gereken grupları gösteren bir liste atarım. Ne yapabileceğimize öyle bakarım.

Sizin bileceğiniz bir durum. Ben burada olursam yardımcı olurum. Yoksa başka arkadaşlar yardımcı olur sanırım.