- Katılım
- 18 Kasım 2020
- Mesajlar
- 71
- Excel Vers. ve Dili
- İngilizce / office 2016
- Altın Üyelik Bitiş Tarihi
- 01-12-2023
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
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