Koşullu olarak satır verisini aktarma makrosu nasıl olmalı?

[Araştırıcı]

Değerli Forum Katılımcıları,
Merhaba.

Aşağıdaki Makro ile "olumsuz" adlı sayfaya veri aktarmaktayım. İstediğimde hücrede çift tıklama olayı ile "olumsuz" isimli sayfaya veri aktarıyorum. Ancak olumlu isimli bir sayfaya da aynı şekilde veri aktarmam gerekli. Koşullu olarak Bu makroya nasıl bir ekleme gerekecektir?

Mesela, <<&#231;ift t&#305;klanacak h&#252;creye e&#287;er "olumsuz" de&#287;eri girilmi&#351; ise bulundu&#287;u t&#252;m sat&#305;r&#305; olumsuz sayfas&#305;na, olumlu girilmi&#351; ise olumlu sayfas&#305;na aktar >> &#351;eklinde nas&#305;l yazar&#305;z?
A&#351;a&#287;&#305;da sadece ko&#351;ulsuz olarak olumsuz sayfas&#305;na aktarma yapabilmekteyim. Nas&#305;l bir ekleme ya da de&#287;i&#351;iklik yapmal&#305;y&#305;z.

Sayg&#305;lar&#305;mla


Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error Resume Next

If Intersect(Target, [B:V]) Is Nothing Then Exit Sub
If ActiveSheet.Name = "olumsuz" Then Exit Sub
If Target <> "" Then
Cancel = True
Set S3 = Sheets("olumsuz")
SATIR = S3.[b65536].End(3).Row
If SATIR = 1 And S3.[b1] = "" Then

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

 

[Recep İpek]

Aşağıdaki kodları sayfanın VBE bölümüne kopyalayabilirsiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim s1, s2, s3 As Object
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
Cancel = True
Set s1 = Sheets("veri")
If Target.Value = "Olumlu" Then
Set s2 = Sheets("Olumlu")
sat = s2.[b65536].End(3).Row + 1
s2.Cells(sat, "a").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 = "Olumsuz" Then
Set s3 = Sheets("Olumsuz")
sat = s3.[b65536].End(3).Row + 1
s3.Cells(sat, "a").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
Else
Exit Sub
End If
Target.Offset(1, 0).Select
Set s1 = Nothing
End Sub