• FORUMU MOBİL UYGULAMADAN TAKİP EDİN

    Forumu isteyen üyelerimiz Tapatalk (Harici bir hizmet) üzerinden mobil uygulamadan takip edebilirler.
    iOS için : https://itunes.apple.com/app/id307880732?mt=8
    Android için : https://play.google.com/store/apps/details?id=com.quoord.tapatalkpro.activity
    adreslerinden indirebilirsiniz.

    Bir iki haftaya da foruma özel kendi uygulamamız yayında olacak.
ALTIN ÜYELİK Hakkında Bilgi
-----------------------

Mükerrer olanları farklı sayfalara aktarma

bunyaming

Altın Üye
Altın Üye
Katılım
13 Ocak 2017
Mesajlar
74
Beğeniler
0
Excel Vers. ve Dili
2010 türkçe
#1
Merhaba,

Eklediğim dosya da B sütununda yer alan verileri İl isimlerine göre filtreleyip, her bir il için ayrı sayfalara kopyalaması ve kopyalanan örneğin İstanbul ise sayfa isminin de İstanbul olması mümkünmüdür?

Hergün bununla çokça uğraşıyoruz yardımcı olabilirseniz sevinirim

teşekkürler
 

Ekli dosyalar

Katılım
8 Mart 2011
Mesajlar
11,029
Beğeniler
124
Excel Vers. ve Dili
Office 2013 TÜRKÇE
#2
Merhaba.

Alt taraftan Sayfa1 adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sağdaki boş alana aşağıdaki kod blokunu yapıştırıp çalıştırın.
Dikkat: Kod önce, varsa ismi Sayfa1'den farklı olan sayfaları siler, ardından istenilen işlemi yapar.
Gerçek belgenizde de verilerin
1'inci satırdan başladığı (başlık satırının olmadığı) varsayıldı.
Rich (BB code):
Sub BARAN()
Set S1 = Sheets("Sayfa1")
If S1.AutoFilterMode = True Then S1.AutoFilterMode = False
Application.DisplayAlerts = False
For Each shf In ThisWorkbook.Sheets
    If shf.Name <> "Sayfa1" Then shf.Delete
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
S1.Rows("1:1").Insert Shift:=xlDown
If S1.[A1] = "İLÇE" Then: S1.Rows("1:1").Delete Shift:=xlUp
S1.[A1] = "İLÇE": S1.[B1] = "İL"
son = S1.Cells(Rows.Count, 1).End(3).Row
For sat = 2 To son
    If WorksheetFunction.CountIf(S1.Range("B2:B" & sat), S1.Cells(sat, 2)) = 1 Then
    S1.Range("A1:B" & Rows.Count).AutoFilter Field:=2, Criteria1:=S1.Cells(sat, 2)
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = S1.Cells(sat, 2)
    S1.Range("A2:B" & son).Copy ActiveSheet.[A1]
    End If
Next
S1.Rows("1:1").Delete Shift:=xlUp
S1.Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox Sheets.Count - 1 & " adet sayfa oluşturularak ilçeler aktarıldı.", vbInformation, "..:: Ömer BARAN ::.."
End Sub
 
Son düzenleme:

bunyaming

Altın Üye
Altın Üye
Katılım
13 Ocak 2017
Mesajlar
74
Beğeniler
0
Excel Vers. ve Dili
2010 türkçe
#3
Merhaba.

Alt taraftan Sayfa1 adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sağdaki boş alana aşağıdaki kod blokunu yapıştırıp çalıştırın.
Dikkat: Kod önce, varsa ismi Sayfa1'den farklı olan sayfaları siler, ardından istenilen işlemi yapar.
Gerçek belgenizde de verilerin
1'inci satırdan başladığı (başlık satırının olmadığı) varsayıldı.
Rich (BB code):
Sub BARAN()
Set S1 = Sheets("Sayfa1")
If S1.AutoFilterMode = True Then S1.AutoFilterMode = False
Application.DisplayAlerts = False
For Each shf In ThisWorkbook.Sheets
    If shf.Name <> "Sayfa1" Then shf.Delete
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
S1.Rows("1:1").Insert Shift:=xlDown
If S1.[A1] = "İLÇE" Then: S1.Rows("1:1").Delete Shift:=xlUp
S1.[A1] = "İLÇE": S1.[B1] = "İL"
son = S1.Cells(Rows.Count, 1).End(3).Row
For sat = 2 To son
    If WorksheetFunction.CountIf(S1.Range("B2:B" & sat), S1.Cells(sat, 2)) = 1 Then
    S1.Range("A1:B" & Rows.Count).AutoFilter Field:=2, Criteria1:=S1.Cells(sat, 2)
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = S1.Cells(sat, 2)
    S1.Range("A2:A" & son).Copy ActiveSheet.[A1]
    End If
Next
S1.Rows("1:1").Delete Shift:=xlUp
S1.Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox Sheets.Count - 1 & " adet sayfa oluşturularak ilçeler aktarıldı.", vbInformation, "..:: Ömer BARAN ::.."
End Sub
Ömer Bey Merhaba,

öncelikle bu kadar uğraşıp emek verdiğiniz için sonsuz teşekkürler.
Şuan ki hali ile mükemmel çalışıyor,problem yok sadece ilave bir sorum daha olacaktı.
örneğin sayfa isimlerini açıyor ve istanbul karşılığına gelenleri aktarıyor o şekilde değilde istanbul olarak filtrelenen kısımdan yani a ve b sütunlarında ki bilgileri olduğu gibi aktarabilirmi acaba?
 
Katılım
8 Mart 2011
Mesajlar
11,029
Beğeniler
124
Excel Vers. ve Dili
Office 2013 TÜRKÇE
#4
Önceki cevabımdaki kod'da sütun adı değişikiğini yaptım (kırmızı büyük karakterli kısım).
Sayfayı yenileyerek kontrol edin.
 
Son düzenleme:
Üst