Filtrele ve başka dosyaya aktar

[zevki.sefali]

Arkadaşlar merhaba
Veri sayfamda müşterilere ait satış hareketleri mevcut . Benim istediğim veri sayfasında kaç adet müşteri varsa hepsini teker teker filtreleyip müşteri adında yeni dosya oluşturup o dosyaya verileri yapıştırmak.
Makro ile nasıl yapılabilir. Şimdiden teşekkürler.

 

[Necdet]

Merhaba,
Linki inceleyiniz, 4. mesaj

 

[Mdemir63]

Selamlar
@Necdet Hocam link paylaşmış zaten ancak yine kendisinden faydalandığım
dosyayı yüklüyorum. Umarım faydası olur
Dosyada ki kodlar @Necdet Hocama aittir

İndir

 

[emre8456]

Merhaba,
Linki inceleyiniz, 4. mesaj

Necdet Bey merhaba 10. nolu mesajdaki kodları dosyama uyarlamaya çalıştım ama başaramadım. Kodlar sürekli çalışıyor. hiç dosya kayıt yapmıyor. Benim dosyamda b sütununa göre filtreleme yapılacak ve aynı isimle dosyayı kayıt edecek. Buna göre kodların neresinde değişiklik yapmam gerek

 

[emre8456]

Selamlar
@Necdet Hocam link paylaşmış zaten ancak yine kendisinden faydalandığım
dosyayı yüklüyorum. Umarım faydası olur
Dosyada ki kodlar @Necdet Hocama aittir

İndir

Mdemir bey merhaba link çalışmıyor

 

[zevki.sefali]

Merhaba,
Linki inceleyiniz, 4. mesaj

Necdet Bey Merhaba
kodları dosyama uyarlamaya çalıştım.

Merhaba,
Linki inceleyiniz, 4. mesaj

Teşekkür ederim Necdet bey

 

[zevki.sefali]

Mdemir bey merhaba link çalışmıyor

Link ölü

 

[Mdemir63]

Selamlar

Yeniden yükledim

 

[emre8456]

Selamlar

Yeniden yükledim

Selamlar
sizin dosyanıza baktım. filtrelenecek isimleri siz belirlemişsiniz. Dosyamdaki veriler sürekli değişeceği için bu şekilde işime yaramıyor. Veri sayfasında kaç adet firma varsa onu kendisi bulup filtrelemeli

 

[Mdemir63]

Selamlar
sizin dosyanıza baktım. filtrelenecek isimleri siz belirlemişsiniz. Dosyamdaki veriler sürekli değişeceği için bu şekilde işime yaramıyor. Veri sayfasında kaç adet firma varsa onu kendisi bulup filtrelemeli

Anladım. Ben zaten konuyu açan arkadaşa fikir vermesi açısından paylaştım.
Zaten Dikkat ettiyseniz benim isteğime göre @Necdet Hocam dosyayı oluşturmuştu.
İyi çalışmalar

 

[alicimri]

Mevcut dosyanın kodlarını değiştirdim. Dosyadaki ana dışındaki sayfaları silin, kod ile oluşacak.

Sub SuzAktar() 'NECDET ABİ
Application.ScreenUpdating = False
Set s1 = Sheets("ana")
Son = s1.[B65536].End(3).Row
For i = 2 To Son
If InStr(ad, s1.Cells(i, 2)) = 0 Then
     Sheets.Add
 s1.Range("A1:G" & Son).AutoFilter
    s1.Range("A1:G" & Son).AutoFilter Field:=2, Criteria1:=s1.Cells(i, 2)
    s1.Range("A1:G" & Son).Copy ActiveSheet.Range("a1")
   ActiveSheet.Name = s1.Cells(i, 2)
   ad = ad & s1.Cells(i, 2)
End If
Next
 s1.Range("A1:G" & Son).AutoFilter
Sheets("ANA").Move before:=Sheets(1)
Application.ScreenUpdating = True
End Sub

 

[emre8456]

Mevcut dosyanın kodlarını değiştirdim. Dosyadaki ana dışındaki sayfaları silin, kod ile oluşacak.

Sub SuzAktar() 'NECDET ABİ
Application.ScreenUpdating = False
Set s1 = Sheets("ana")
Son = s1.[B65536].End(3).Row
For i = 2 To Son
If InStr(ad, s1.Cells(i, 2)) = 0 Then
     Sheets.Add
s1.Range("A1:G" & Son).AutoFilter
    s1.Range("A1:G" & Son).AutoFilter Field:=2, Criteria1:=s1.Cells(i, 2)
    s1.Range("A1:G" & Son).Copy ActiveSheet.Range("a1")
   ActiveSheet.Name = s1.Cells(i, 2)
   ad = ad & s1.Cells(i, 2)
End If
Next
s1.Range("A1:G" & Son).AutoFilter
Sheets("ANA").Move before:=Sheets(1)
Application.ScreenUpdating = True
End Sub

Teşekkürler Ali Bey elinize sağlık