Çoklu Kopyalamada Check Box Kullanımı

[mustafa1205]

Örnek dosyamda açıklama yaptım. Buton yardımı ile çoklu kopyalama yapıyorum.İstediğim şey (aklıma şuan check box kullanımı geliyor) seçim yaparak istediklerim hariçleri kopyalama yapmak. Teşekkür ederim.

 

[Orion1]

Dosyanız ektedir.

Private Sub CommandButton1_Click()
Dim sat1 As Long, sat2 As Long, ckbx As Object
sat1 = Cells(Rows.Count, "D").End(xlUp).Row + 1
For Each chbx In Me.Controls
    If TypeName(chbx) = "CheckBox" Then
        If chbx.Value = False Then Cells(sat1, "D").Value = CLng(chbx.Tag): sat1 = sat1 + 1
        
    End If
Next
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
Unload Me
End Sub

 

[mustafa1205]

Hocam harikasınız.Zaten bu kodlarıda siz hazırlamıştınız.Tam istediğim gibi olmuş. Birşey daha isteyebilirmiyim eğer vaktiniz olursa. Malum G hücresinden istenilenleri D hücresine kopyalama yaptık peki A,B,C hücrelerinde bulunan verileride D hücresine kopyalanan miktar kadar aynı anda alt alta kopyalama yapabilir miyiz acaba ?

 

[Orion1]

Hocam harikasınız.Zaten bu kodlarıda siz hazırlamıştınız.Tam istediğim gibi olmuş. Birşey daha isteyebilirmiyim eğer vaktiniz olursa. Malum G hücresinden istenilenleri D hücresine kopyalama yaptık peki A,B,C hücrelerinde bulunan verileride D hücresine kopyalanan miktar kadar aynı anda alt alta kopyalama yapabilir miyiz acaba ?

Dosya üzerinde siz 3-5 tane yapın göreyim.

 

[mustafa1205]

Hocam örnek dosyayı ekledim. Kusura bakmayın 1 saat sonra size dönme imkanım olacak. Vaktiniz olursa dosya ektedir.

 

[Orion1]

nerden neyi kopyalayacaz?

 

[Orion1]

ekli dosyayı inceleyiniz.

Private Sub CommandButton1_Click()
Dim sat1 As Long, sat2 As Long, ckbx As Object
sat1 = Cells(Rows.Count, "D").End(xlUp).Row + 1
Range("A" & sat1 - 1 & ":C" & sat1 - 1).Copy
For Each chbx In Me.Controls
    If TypeName(chbx) = "CheckBox" Then
        If chbx.Value = False Then
            Cells(sat1, "D").Value = CLng(chbx.Tag)
            Range("A" & sat1).PasteSpecial
            sat1 = sat1 + 1
            oldu = True
        End If
    End If
Next
Application.CutCopyMode = False
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
Unload Me
End Sub

 

[mustafa1205]

Sayın Orion Hocam çok teşekkür ediyorum. Tek kelime ile mükemmel oldu. İşime çok yarayacak. Yeni cevap yazabildim. Kusurabakmayın.Şimdi kendi asıl çalışmama uyarlıyorum.Allah razı olsun.Keşke kısmet olsada bizimde size bir faydamız olsa ama bilgimiz kıt.Kusura bakmayın.Hayırlı akşamlar diliyorum.

 

[mustafa1205]

ekli dosyayı inceleyiniz.

Private Sub CommandButton1_Click()
Dim sat1 As Long, sat2 As Long, ckbx As Object
sat1 = Cells(Rows.Count, "D").End(xlUp).Row + 1
Range("A" & sat1 - 1 & ":C" & sat1 - 1).Copy
For Each chbx In Me.Controls
    If TypeName(chbx) = "CheckBox" Then
        If chbx.Value = False Then
            Cells(sat1, "D").Value = CLng(chbx.Tag)
            Range("A" & sat1).PasteSpecial
            sat1 = sat1 + 1
            oldu = True
        End If
    End If
Next
Application.CutCopyMode = False
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
Unload Me
End Sub

Yukarıda bulunan kodlarda Evren Hocam işimi fazlasıyla gördü.Ancak benden kaynaklanan bir dikkatsizlik nedeniyle sorumu tam soramamışım çünkü asıl çalışmamda plan sayısı 4 adet ve ben bu kodları çalışmama uygulayamadım. Evren Hocam çevrim dışı görünüyor.Eğer imkanı olan hocalarım olursa ekte bulunan dosya 1 deki (yani üstte bulunan ) kodları Dosya 2 de bulunan kodlarla harmanlama yapmak. Ancak asıl olmasını istediğim Dosya 1 deki kopyalama şekli olacak. Sadece plan kopyalamalar eklenecek.

 

[mustafa1205]

Bir üst mesajdaki anlatımımın eksik olduğunu düşünerek yeni basitleştirilmiş dosya ekliyorum.Yardımlarınız için şimdiden teşekkürler.

 

[Orion1]

Dosyanız ektedir.

Private Sub CommandButton1_Click()
Dim sat1 As Long, sat2 As Long, ckbx As Object
sat1 = Cells(Rows.Count, "D").End(xlUp).Row + 1
Range("A" & sat1 - 1 & ":C" & sat1 - 1).Copy
For Each chbx In Me.Controls
    If TypeName(chbx) = "CheckBox" Then
        If chbx.Value = False Then
            Cells(sat1, "D").Value = Replace(chbx.Caption, " HARİÇ", "")
            Range("A" & sat1).PasteSpecial
            sat1 = sat1 + 1
            oldu = True
        End If
    End If
Next
Application.CutCopyMode = False
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
Unload Me
End Sub

 

[mustafa1205]

Evren Hocam eline sağlık çok güzel olmuş tam istediğim gibi ancak şunu sormak istiyorum. Bu A planı yazan "G" sütununun yanında 4 adet daha plan var.Ben sizin yaptığınızı onlara uygularım dedim ama G sütunundaki bilgileri alıp nasıl kopyalattırdınız onu anlayamadım. Eğer anlayabilirsem H,I,J, sütunlarında da birtakım veriler olacak ve aynı işlemi onlarada yaptıracağım

 

[mustafa1205]

Yani sizin verdiğiniz bu güzel kodları ekteki dosyaya uyarlamayı yapamadım

 

[mustafa1205]

Evren Hocam şimdi anladım siz verileri check box üzerinde yazan verileri yazdırıyorsunuz. Ben hücrelerden aldığınızı zannetmiştim. Şimdi oldu. Sadece şunu sormak istiyorum. Aynı User form üzerine ikinci plan yapıldığında mevcut kodlar aynımı kalacak ekleme yada çıkarma olacak mı ?

 

[Orion1]

Evren Hocam şimdi anladım siz verileri check box üzerinde yazan verileri yazdırıyorsunuz. Ben hücrelerden aldığınızı zannetmiştim. Şimdi oldu. Sadece şunu sormak istiyorum. Aynı User form üzerine ikinci plan yapıldığında mevcut kodlar aynımı kalacak ekleme yada çıkarma olacak mı ?

userforma istediğiniz kadar çek box ekleyebilirsiniz.
çekboxın captionlarına bakarak ve g sütunda yerlere bakarak çalışıyor.
Sanırım g sütunda şu anki aralığa kadar çalışıyor.
Ben size 1 kez denemenizi önereceğim.
Kolay gelsin.

 

[mustafa1205]

Evren Hocam çok teşekkür ederim.Cevap yazma fırsatım yeni oldu. En kısa zamanda deneyip size bilgi vereceğim