Cari hesap ekstresi

[manasız]

Arkadaşlar ekte sunduğum dosya borçluları borçu sayfasına alaçaklıları alaçaklı sayfasına aktarılmasını istiyorum sütünu ile birlikte bu konuda yardımlarınızı esirgemeyin lütfen

 

[Orion1]

Dosyanız ekte.

Sub aktar()
Dim i As Long, adr1 As String, adr2 As String, sat As Long
If MsgBox("Aktarma Yapmak İstiyormusunuz?", vbYesNo + vbQuestion, "AKTARMA") = vbNo Then Exit Sub
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
For i = 2 To Cells(65536, "E").End(xlUp).Row
    sat = Sheets(Cells(i, "E").Value).Cells(65536, "A").End(xlUp).Row + 1
    If sat >= 65533 Then
        MsgBox "[ " & Cells(i, "E").Value & _
        " ] Sayfasında Satır doldu .Bu sayfaya Başka kayıt yapamazsınız..!!" _
        , vbCritical, "UYARI"
        GoTo atla
    End If
        adr1 = Range(Cells(i, "A"), Cells(i, "E")).Address
        adr2 = Range(Cells(sat, "A"), Cells(sat, "E")).Address
        Sheets(Cells(i, "E").Value).Range(adr2).Value = _
        Range(adr1).Value
atla:
Next i
Application.ScreenUpdating = True
MsgBox "Aktarma tamamlandı..!!"
End Sub

 

[manasız]

Güzel yapmışsın ilgin için teşekkür ederim ama otamatik olmasını istiyorum otamatik atmasını bu mümkünmü

 

[manasız]

Sorun

Hocam teşkür ederim ilgin için birde şu eke bakarmısın o yaptığın olmuş ama benim istediğim gibi olmamış