Sadece Seçtiğim Alan

[KaraKartall99]

Merhabalar

Aşağıda vereceğim kodu çalıştırdığımda tüm sayfadaki verileri diğer sayfaya taşıyor, oysa ben sadece beni mause ile seçtiğim aralıktaki verileri diğer sayfaya taşımak istiyorum. İnputbox ile mi çözeriz bu durumu

KODLAR:
Sub SecilenSayfalar()

Dim Syf As Worksheet, _
i As Long, _
Son As Long, _
j As Long, _
ShB As Worksheet

Set ShB = Sheets("BLOKE KARTI")

For j = 5 To ShB.Cells(Rows.Count, "A").End(3).Row Step 14
If ShB.Cells(j, "F") = 0 Then Exit For

Next j

MsgBox ActiveWindow.SelectedSheets.Count & " ADET SAYFA SEÇTINIZ, ISLEMLERI BASLATACAGIM.... N.Y"

For Each Syf In ActiveWindow.SelectedSheets

Son = Syf.Cells(Rows.Count, "B").End(3).Row
If Son < 4 Then Son = 4

For i = 4 To Son

If Syf.Cells(i, "Q") = "" Then

ShB.Range("F" & j) = Syf.Cells(i, "B") 'Parça No
ShB.Range("D" & j + 2) = Syf.Cells(i, "E") 'Hata
ShB.Range("D" & j + 4) = Syf.Cells(i, "D") 'Adet
ShB.Range("G" & j + 4) = Syf.Cells(i, "G") 'Tarih
ShB.Range("J" & j + 4) = Syf.Cells(i, "H") 'Isim
' ShB.Range("D" & j + 6) = Syf.Cells(i, "H") 'Açiklama ?
ShB.Range("J" & j + 6) = Syf.Cells(i, "C") 'Sarj
ShB.Range("E" & j + 8) = Syf.Cells(i, "F") 'Kart Sira No
Syf.Cells(i, "Q") = "ü"
j = j + 14

End If

Next i

Next Syf

End Sub