Makro ile rapor hazırlamak

[selim_1]

Arkadaşlar merhabalar.
Ekteki tabloyu düşeyara ile değilde(Çok yer kapladığı için) makro ile yapmak istiyorum.
Yardımlarınızı rica ederim.
Kodları Türkçe EXCEL yazabilirseniz iyi olur.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub AKTAR()
    Application.ScreenUpdating = False
    Set S1 = Sheets("Data")
    Set S2 = Sheets("yvxdelnr")
    S1.Select
    [D2:D65536,F2:F65536].ClearContents
    S2.[A2:A65536].Copy S1.[E2:E65536]
    S2.[B2:C65536].Copy S1.[A2:B65536]
    
    For X = 3 To Sheets.Count
    For Y = 2 To [A65536].End(3).Row
    Set Bul = Sheets(X).Cells.Find(S1.Cells(Y, 5))
    If Not Bul Is Nothing Then
    Adres = Bul.Address
    Do
    Satır = Bul.Row
    S1.Cells(Y, 4) = Sheets(X).Cells(Satır, 3)
    S1.Cells(Y, 6) = Sheets(X).Cells(Satır, 2)
    Set Bul = Sheets(X).Cells.FindNext(Bul)
    Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
    Next
    Next
    Set S1 = Nothing
    Set S2 = Nothing
    Application.ScreenUpdating = True
    MsgBox "&#304;&#350;LEM&#304;N&#304;Z TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[selim_1]

Teşekkürler
Arkadaşlar,emeğinize sağlık.