Yardım Kitap Takip Rapor Sayfası

Sub Emre()
    Dim i&, a&, son&, say%
    Application.ScreenUpdating = False
    Sayfa2.Range("A2:ZZ50000").ClearContents
    With Sayfa1
        For i = 2 To .Cells(Rows.Count, "C").End(3).Row
            son = Sayfa2.Cells(Rows.Count, "E").End(3).Row + 1
            For a = 6 To .Cells.SpecialCells(11).Column Step 3
                If .Cells(i, a).Value <> "" Then
                    Sayfa2.Cells(son, "A").Resize(, 4).Value = .Range("B" & i).Resize(, 4).Value
                    say = WorksheetFunction.CountIf(Sayfa2.Range("A:A"), Sayfa2.Cells(son, 1))
                    If say > 1 Then Sayfa2.Range("A" & son).Resize(, 4).Value = ""
                    Sayfa2.Cells(son, 4).Offset(0, 1).Resize(, 3).Value = .Range(.Cells(i, a), .Cells(i, a + 2)).Value
                    son = son + 1
                End If
            Next a
        Next i
    End With
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlandı.", vbInformation, "Www.ExcelTurkey.Com"
    i = Empty: a = Empty: son = Empty: say = Empty
End Sub