Karşılıklı olarak hesapların yer değiştirmesi

[1903emre34@gmail.com]

Merhaba,

Hesap kodları karşısında gelen tutarların birbiriyle karşılıklı olarak yer değiştirmesini istiyorum, 100 hesabındaki tutarları borç bakiyesinde tutarlar alacak (D sütündaki veriler) C sütünüyla karşılık olarak yer değiştirmesi, Borç bakiyesi (E sütündaki) Alacak bakiyesi ("F") karşılıklı olarak yer değiştirmesi istiyorum, istenen sayfa2'de yapılmıştır, örnek olarak kısaltılmıştır.

 

[Ziynettin]

Merhaba,

Kodu bir defa çalıştırın.

Sub degistir()
son = Cells(Rows.Count, 1).End(3).Row
Dim a(): a = Range("A4:F" & son)
Dim b(): ReDim b(1 To UBound(a), 1 To 4)
For i = 1 To UBound(a)
    say = say + 1
    b(say, 1) = a(i, 4)
    b(say, 2) = a(i, 3)
    b(say, 3) = a(i, 6)
    b(say, 4) = a(i, 5)
Next i
[H4].Resize(say, 4) = b
MsgBox "İşlem tamam.", vbInformation
End Sub

 

[1903emre34@gmail.com]

Teşekkürler, sorunsuz çalışıyor.