Son iki sütunu başka sayfaya kopyalama

[Tevfik_Kursun]

Merhaba arkadaşlar,
Ekli örnek dosyada sayfa1 'e her ay iki sütun ekleniyor. Bilgi alınacağı zaman sayfa1 de son iki sütundaki bilgiyi sayfa2 ye G6 dan itibaren makro ile bir sütun aralıklı kopyalamak istiyorum.
Yardımcı olursanız sevinirim.
Saygılarımla

http://s3.dosya.tc/server12/4h99ti/Ornek78.xlsx.html

 

[Ziynettin]

Merhaba,

Sub son_sutun2_aktar()
Dim a(), b(), i As Long, x As Integer, S As Long
Dim Son As Long, Sut As Integer
With Sheets("Sayfa1")
Son = .Columns("C:C").Find("?", , , , xlByRows, xlPrevious).Row
Sut = .Rows("7:7").Find("?", , , , xlByColumns, xlPrevious).Column
    If Son < 7 Or Sut < 5 Then
        MsgBox "Yetersin alan ", vbCritical
        Exit Sub
    End If
a = .Range(.Cells(7, 3), .Cells(Son, Sut)).Value
End With
ReDim b(1 To UBound(a), 1 To 2)
For i = 1 To UBound(a)
    S = S + 1
    b(S, 1) = a(i, UBound(a, 2) - 1)
    b(S, 2) = a(i, UBound(a, 2))
Next i
With Sheets("Sayfa2")
.[G6].Resize(S) = Application.Index(b, , 1)
.[I6].Resize(S) = Application.Index(b, , 2)
End With
MsgBox "   İşlem tamam...", vbInformation
End Sub

 

[Tevfik_Kursun]

Sayın Ziynettin Hocam,
İlginize çok teşekkür ederim.
Saygılarımla