DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Makro2()
[B4:B17].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[G4], Unique:=True
For i = 5 To 17
c = 7
For Each hcr In [B5:B17]
If Cells(i, "G") = hcr.Text Then
c = c + 1
Cells(i, c) = hcr.Offset(0, 1).Value
End If
Next
c = 0
Next
End Sub