Soru Listeleme Şeklinde Düzenleme

[igultekin2000]

İyi günler; yıllara yaygın çalışma sayfalarındaki " H " sütununa göre firmaları listeleme yapıyorum. Listeleme şeklini " H " ve " I " birleşimi şekline çevirmek istiyorum. Örnek dosyayı ekliyorum. Teşekkürler

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub FirmaListele()

Dim i As Long, _
f As String, _
Syf As Worksheet, _
sf As Worksheet, _
sd As Object

Set sf = Sheets("firmalar")
Set sd = CreateObject("Scripting.Dictionary")

i = sf.Cells(Rows.Count, "A").End(3).Row + 1
sf.Range("A2:A" & i).ClearContents

For Each Syf In Worksheets

If IsNumeric(Syf.Name) Then
For i = 2 To Syf.Cells(Rows.Count, "A").End(3).Row
f = Trim(Syf.Cells(i, "I")) & "-" & Trim(Syf.Cells(i, "H"))
If Not sd.exists(f) Then sd.Add f, ""
Next i
End If

Next Syf

sf.Range("A2").Resize(sd.Count, 1) = Application.Transpose(Array(sd.keys))
MsgBox "İşlem Tamamlanmıştır....", vbInformation, "www.excel.web.tr - Necdet"

End Sub

 

[igultekin2000]

Teşekkür ederim, sorunsuz çalışıyor. İyi çalışmalar.

 

[Necdet]

Güle güle kullanın.