çift tıklanan hücre ile satır aktarması

[Araştırıcı]

Merhaba,
Herkese iyi çalışmalar.

1. Ekteki dosyamda yer alan, "Aktarılan İşler" sayfasından, "SP1" , "SP2 "Parakende" ve "Durum" isimli sayfalara satırlar halinde veri aktarılmaktadır.
2. Aktarma işlemi : Aktarılacak satır seçilip hücre çift tıklanarak yapılmaktadır.
Sonuç: Tıklanan hücrenin bulunduğu satır olduğu gibi aktarılamaktadır.

Sorun:Aktarılan sayfalardaki satırlara manuel giriş yapılmaktadır.
Aktarma işlemi çalıştırıldığında aktarılan satırlar manuel olarak girilmiş verilerin üzerine yerleşmektedir. Elle girilenler silinmeden bir alt satır devamını sağlamak için nasıl bir yazılım yapmak gerekecektir. Aşağıdaki metod sadece belirlenmiş tek sayfa için "Durumu" sayfasına T sütununu ele alarak yapabilmektedir.
Bu seneryoyu yukardaki istenen olay için nasıl geliştirebiliriz.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, [T:T]) Is Nothing Then Exit Sub
If ActiveSheet.Name = "DURUMU" Then Exit Sub
If Target <> "" Then
Cancel = True
Set S3 = Sheets("DURUMU")
SATIR = S3.[T65536].End(3).Row
If SATIR = 1 And S3.[T1] = "" Then

S3.Range("T" & SATIR & ":B" & SATIR) = Range("T" & Target.Row & ":B" & Target.Row).Value
Set S3 = Nothing
Else
SATIR = SATIR + 1
S3.Range("T" & SATIR & ":B" & SATIR) = Range("T" & Target.Row & ":B" & Target.Row).Value
End If
End If
Set S3 = Nothing
MsgBox "AKTARIM &#304;&#350;LEM&#304; TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[Recep İpek]

SATIR = S3.[T65536].End(3).Row

Manuel veri girerken T kolonuna herhangi bir veri giriyormusunuz?

Girmiyorsan&#305;z makro do&#287;al olarak bu kolonu sayd&#305;&#287;&#305; i&#231;in bu kolondaki son veriye g&#246;re kay&#305;t yapacakt&#305;r.

Ayr&#305;ca a&#351;a&#287;&#305;daki linkteki sorununuz &#231;&#246;z&#252;mlendi mi?


http://www.excel.web.tr/showthread.php?t=35099

 

[Araştırıcı]

Hedef sütun birden çok olursa nasıl bir kod ekleriz?

Sayın Ripek,
Gönderilen linkten bir çalışma çıkarmaya çalıştım. Target (N:N) için sorun olmadan olayı çözdük. Ancak Target hem N Sütunu hemde U sütunu olursa aşağıdaki gibi bir başlangıç olabilir mi, ya da kodları nasıl revize etmemiz gerekir.
Birden çok Target sütunu ile çalışacaksa olayın mantığı ne olmalı?
Sizin yönlendirmenize göre oluşturmaya çalıştığım kodlar aşağıdadır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim s1, s2, s3, S4 As Object
If Intersect(Target, [N:N], [U:U]) Is Nothing Then Exit Sub
Cancel = True
Set s1 = Sheets("aktarılan işler")
If Target.Value = "SP1" Then
Set s2 = Sheets("SP1")
sat = s2.[b65536].End(3).Row + 1
s2.Cells(sat, "b").Value = sat - 1
s2.Range(s2.Cells(sat, "b"), s2.Cells(sat, "v")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "v")).Value
Set s2 = Nothing
ElseIf Target.Value = "SP2" Then
Set s3 = Sheets("SP2")
sat = s3.[b65536].End(3).Row + 1
s3.Cells(sat, "b").Value = sat - 1
s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "v")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "v")).Value
Set s3 = Nothing
ElseIf Target.Value = "SP3" Then
Set s3 = Sheets("SP3")
sat = s3.[b65536].End(3).Row + 1
s3.Cells(sat, "b").Value = sat - 1
s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "v")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "v")).Value
Set s3 = Nothing
ElseIf Target.Value = "PARAKENDE" Then
Set s3 = Sheets("PARAKENDE")
sat = s3.[b65536].End(3).Row + 1
s3.Cells(sat, "b").Value = sat - 1
s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "v")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "v")).Value
Set s3 = Nothing

ElseIf Target.Value = "OLUMSUZ" Then
Set S4 = Sheets("OLUMSUZ")
sat = S4.[b65536].End(3).Row + 1
S4.Cells(sat, "b").Value = sat - 1
S4.Range(S4.Cells(sat, "b"), S4.Cells(sat, "v")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "v")).Value
Set S4 = Nothing

Else
Exit Sub
End If
Target.Offset(1, 0).Select
Set s1 = Nothing
End Sub