• Web sitemize destek olmak, Hazır Excel Dosyaları indirmek ve sitemizi reklamsız kullanmak için VIP Üyelik Satın alabilirsiniz.
    Hesabını VIP Üyeliğe Yükselt

Çözüldü İşaretli satırları başka sayfaya kopyalama

nasyarx

VIP
VIP
Kullanıcı
Yaş
39
Versiyon
  1. Excel 2016
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Selamlar,
Sayfadan işaretli olan satırları başka sayfaya kopyalamak istiyorum. Yardımcı olursanız sevinirim.
 

Ekli dosyalar

  • sınıf.xlsm
    27 KB · Görüntüleme: 3
Çözüm
Artık çift tıklama D2:K2 için de geçerlidir.
B sütununa çift tıklandığı sırada D2:K2'de tik işareti olan sütunlar aktarılır.

C#:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B4:B55, D2:K2")) Is Nothing Then
    Cancel = True
    If Target.Row = 2 Then
        If Target.Value = "ü" Then
            Target.Value = Empty
        ElseIf Target.Value = Empty Then
             Target.Value = "ü": Target.Font.Name = "Wingdings"
             Target.Font.Size = 12: Target.HorizontalAlignment = xlCenter
             Target.VerticalAlignment = xlCenter: Target.Font.ColorIndex = 10
        End If
        Exit Sub
    End If
    Dim XD As Integer, XDsu As Integer, s As...

Ömer BARAN

Kurucu
Yönetici
Kurucu
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

@nasyarx

-- B sütununa her çift tıklama işleminde (tik işareti koyulduğunda) çift tıklanan satırı mı aktarmak istiyorsunuz?
-- Mevcut verilere göre tik işaretli satırları mı aktarmak istiyorsunuz?
-- SEÇİLEN sayfasına aktarılan veriler SINIF sayfasında kalmaya devam mı edecek, yoksa kes yapıştır gibi mi olacak yoksa
SEÇİLEN sayfasında ilgili satırda uygun bir sütuna o satırın aktarıldığını gösteren bir işaret, simge vs koyulacak mı?
-- SEÇİLEN sayfasına aktarma yapıldıktan sonra, tekrar aktarma kodu çalıştırılmak istenildiğinde,
SEÇİLEN sayfasında mevcut eski veriler silinecek mi, yoksa mevcut verilerin altına ekleme şeklinde mi aktarma istiyorsunuz?

.
 

nasyarx

VIP
VIP
Kullanıcı
Yaş
39
Versiyon
  1. Excel 2016
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

@nasyarx

-- B sütununa her çift tıklama işleminde (tik işareti koyulduğunda) çift tıklanan satırı mı aktarmak istiyorsunuz?
-- Mevcut verilere göre tik işaretli satırları mı aktarmak istiyorsunuz?
-- SEÇİLEN sayfasına aktarılan veriler SINIF sayfasında kalmaya devam mı edecek, yoksa kes yapıştır gibi mi olacak yoksa
SEÇİLEN sayfasında ilgili satırda uygun bir sütuna o satırın aktarıldığını gösteren bir işaret, simge vs koyulacak mı?
-- SEÇİLEN sayfasına aktarma yapıldıktan sonra, tekrar aktarma kodu çalıştırılmak istenildiğinde,
SEÇİLEN sayfasında mevcut eski veriler silinecek mi, yoksa mevcut verilerin altına ekleme şeklinde mi aktarma istiyorsunuz?

.
* Tik işaretli olan satırları SEÇİLEN sayfaya kopyalamak istiyorum. Fakat çift tıklama ile satır kopyalama işlemi olacak ise tik kalktığında SEÇİLEN sayfasından ilgili satır da silinmeli.
* Bu işlemler SINIF sayfasındaki verileri kalmaya devam edecek.
* Her aktarma mevcut verilerin altına eklenebilir.
Teşekkürler..
 

Ömer BARAN

Kurucu
Yönetici
Kurucu
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

@nasyarx

Mevcut Worksheet_BeforeDoubleClick kod blokunu aşaıdakiyle değiştirin.
ü yazma ve silme işleminin mutlaka ÇİFT TIKLMA ile yapılacağı varsayıldı.

C#:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("b4:b55")) Is Nothing Then
    Cancel = True
    Dim XD As Integer
    XD = WorksheetFunction.CountIf(Range("B3:B" & Target.Row - 1), "ü")
   
    If Target.Value = "ü" Then
        Target.Value = Empty
        Sheets("SEÇİLEN").Range("B" & XD + 5 & ":J" & XD + 5).Delete Shift:=xlUp
    ElseIf Target.Value = Empty Then
        Target.Value = "ü"
        Target.Font.Name = "Wingdings"
        Target.Font.Size = 12
        Target.HorizontalAlignment = xlCenter
        Target.VerticalAlignment = xlCenter
        Target.Font.ColorIndex = 10
        Sheets("SEÇİLEN").Range("B" & XD + 5 & ":J" & XD + 5).Insert
        Range("C" & Target.Row & ":K" & Target.Row).Copy Sheets("SEÇİLEN").Range("B" & XD + 5)
    End If
End If: Target.Activate
End Sub
 

nasyarx

VIP
VIP
Kullanıcı
Yaş
39
Versiyon
  1. Excel 2016
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Ömer Bey, harika oldu. Elinize sağlık. Acaba bu çalışmaya bir ekleme yapabilir miyiz? Sütunları resimdeki gibi checkbox veya tik işareti ile (kopyalanacak satır için) kopyalama seçeneğine dahil etme. Örneğin ad soyad ve tc kimlik seçili ise sadece o sütun bilgileri kopyalansın.
 

Ekli dosyalar

  • resim_2021-04-07_115413.png
    resim_2021-04-07_115413.png
    8 KB · Görüntüleme: 2

Ömer BARAN

Kurucu
Yönetici
Kurucu
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Artık çift tıklama D2:K2 için de geçerlidir.
B sütununa çift tıklandığı sırada D2:K2'de tik işareti olan sütunlar aktarılır.

C#:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B4:B55, D2:K2")) Is Nothing Then
    Cancel = True
    If Target.Row = 2 Then
        If Target.Value = "ü" Then
            Target.Value = Empty
        ElseIf Target.Value = Empty Then
             Target.Value = "ü": Target.Font.Name = "Wingdings"
             Target.Font.Size = 12: Target.HorizontalAlignment = xlCenter
             Target.VerticalAlignment = xlCenter: Target.Font.ColorIndex = 10
        End If
        Exit Sub
    End If
    Dim XD As Integer, XDsu As Integer, s As Object
    Set s = Sheets("SEÇİLEN")
    XD = WorksheetFunction.CountIf(Range("B3:B" & Target.Row - 1), "ü")
    If Target.Value = "ü" Then
        Target.Value = Empty
        s.Range("B" & XD + 5 & ":J" & XD + 5).Delete Shift:=xlUp
    ElseIf Target.Value = Empty Then
        Target.Value = "ü": Target.Font.Name = "Wingdings"
        Target.Font.Size = 12
        Target.HorizontalAlignment = xlCenter
        Target.VerticalAlignment = xlCenter
        Target.Font.ColorIndex = 10
        s.Range("B" & XD + 5 & ":J" & XD + 5).Insert
        Cells(Target.Row, 3).Copy Sheets("SEÇİLEN").Cells(XD + 5, 2)
        For XDsu = 4 To 11
            s.Cells(XD + 5, XDsu - 1).Borders.LineStyle = Cells(Target.Row, XDsu).Borders.LineStyle
            s.Cells(XD + 5, XDsu - 1).Interior.Color = Cells(Target.Row, XDsu).Interior.Color
            If Cells(2, XDsu) = "ü" Then Cells(Target.Row, XDsu).Copy s.Cells(XD + 5, XDsu - 1)
        Next
    End If
End If
End Sub
 
Çözüm
Üst