1'den fazla sayfadaki isimleri tek olacak şekilde farklı sayfaya otomatik yazdırma

[ibrass]

Öncelikle merhaba arkadaşlar. Benim yeri geldiğinde artan ve ya azalan tablolarım var gidilen sefere göre azalıp artıyor. Bu sayfalardaki tablo aralığı B7 ve B24 Arası sabit olacak şekilde bu hücrelere isimleri giriyorum 7-8 tane böyle Sayfa1,Sayfa2,Sayfa3 diye gidiyor diyelim. Bu B7-B24 aralığındaki isimleri ayrı bir sayfada 1 kez olacak şekilde otomatik yazdırmak istiyorum. Yardımcı olabilir misiniz? Makrosuz oluyor mu bilmiyorum fakat makrosuz oluyorsa formülle de olabilir.

 

[Mdemir63]

Selamlar
Belirtiğiniz alanı seçin >Kopyalayın> Ayrı bir sayfaya yapıştırın>Yapıştırdığınız sayfada Ekle menüsünden>Yinelenenleri kaldır>Tamam
diyerek yapabilirsiniz.

 

[ibrass]

Selamlar
Belirtiğiniz alanı seçin >Kopyalayın> Ayrı bir sayfaya yapıştırın>Yapıştırdığınız sayfada Ekle menüsünden>Yinelenenleri kaldır>Tamam
diyerek yapabilirsiniz.

Hocam öncelikle teşekkür ederim. Ben de o şekilde yapıyorum şuanda. Fakat sayfa sayısı bazen 20'ye çıkıyor ayrı ayrı 20 sayfada o hücreleri seçip alt alta yapıştırması zulüm oluyor. Başka bir çözümü yok mudur bu işin acaba?

 

[Mdemir63]

Selamlar
inceleyiniz

indir

 

[Necdet]

Merhaba,

Özet adlı bir sayfa ekleyin ve bu sayfayı silmeyin.
Aşağıdaki kodları bir modüle kopyalayıp, deneyiniz.

Sub TekListele()

    Dim syf As Worksheet, _
        rng As Range, _
        r   As Range, _
        dic As New Dictionary, _
        key As Variant, _
        i   As Integer, _
        n   As Variant
        
    dic.CompareMode = TextCompare
    Sheets("Özet").Range("A1").CurrentRegion.Offset(1).ClearContents
    
    For Each syf In Worksheets
        If Not syf.Name = "Özet" Then
            Set rng = syf.Range("B7:B24")
            For Each r In rng
                n = r.Value
                If Not dic.Exists(n) Then
                    dic.Add r.Value, 0
                End If
            Next r
            Set rng = Nothing
        End If
    Next syf
    
    key = dic.Keys
    Sheets("Özet").Range("A2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(key)
    
End Sub

 

[ibrass]

Merhaba,

Özet adlı bir sayfa ekleyin ve bu sayfayı silmeyin.
Aşağıdaki kodları bir modüle kopyalayıp, deneyiniz.

Sub TekListele()

    Dim syf As Worksheet, _
        rng As Range, _
        r   As Range, _
        dic As New Dictionary, _
        key As Variant, _
        i   As Integer, _
        n   As Variant
       
    dic.CompareMode = TextCompare
    Sheets("Özet").Range("A1").CurrentRegion.Offset(1).ClearContents
   
    For Each syf In Worksheets
        If Not syf.Name = "Özet" Then
            Set rng = syf.Range("B7:B24")
            For Each r In rng
                n = r.Value
                If Not dic.Exists(n) Then
                    dic.Add r.Value, 0
                End If
            Next r
            Set rng = Nothing
        End If
    Next syf
   
    key = dic.Keys
    Sheets("Özet").Range("A2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(key)
   
End Sub

Hocam teşekkür ederim fakat makro konsolunda kod hata veriyor. "compile error user-defined type not defined" hatası çıkıyor karşıma. Altın üye olup linkini paylaşacağım hocam oradan çözümü mutlaka buluruz diye düşünüyorum.

 

[Necdet]

vba penceresinde referanslardan vbscripting runtime modülünü işaretleyip öyle dener misiniz?