cari_firmalar

[igultekin2000]

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.

 

[askm]

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

 

[igultekin2000]

Sorunsuz çalışıyor

Elinize sağlık, sorunsuz çalışıyor.
Teşekkürler.

 

[askm]

Rica ederim. İyi aksamlar.