• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

cari_firmalar

Katılım
5 Eylül 2007
Mesajlar
1,247
Excel Vers. ve Dili
ofis 2010
iyi günler; yıllara ilişkin firmaların ayır çalışma sayfalarında muavin dökümleri var. " I " sütunlarında bulunan firma ünvanlarını (2015-2016-2017) benzersiz olarak "firmalar" çalışma sayfasının " A " sütununa kopyalamak istiyorum.
 

Ekli dosyalar

  • Ornek_Cari.xlsm
    Ornek_Cari.xlsm
    74.9 KB · Görüntüleme: 17
  • firmalar_resim.jpg
    firmalar_resim.jpg
    122.8 KB · Görüntüleme: 4
Kod:
Sub ASKM_Cek()
Dim s As Worksheet
Set s = Sheets("Firmalar")
Dim Son As Long
s.Range("A2:A65000").ClearContents
a = 2
For i = 1 To Worksheets.Count
    If Sheets(i).Name <> "LISTE" And Sheets(i).Name <> "firmalar" Then
        Son = Sheets(i).Range("I" & Rows.Count).End(xlUp).Row
            
        For Satir = 3 To Son
            If WorksheetFunction.CountIf(s.Columns(1), Sheets(i).Cells(Satir, "I")) = 0 Then
                s.Cells(a, 1) = Sheets(i).Cells(Satir, "I")
                a = a + 1
            End If
        Next Satir
    End If
Next i
MsgBox "Veriler aktarıldı...", vbInformation, "ASKM"
End Sub
 
Sorunsuz çalışıyor

Elinize sağlık, sorunsuz çalışıyor.
Teşekkürler.
 
Rica ederim. İyi aksamlar.
 
Geri
Üst