belli bir şartı sağlayan bir excel satırını.......

[ekadak2000]

Merhabalar ekteki dosyada derdimi anlattım yardımlarınız için şimdiden teşekkürler

 

[N.Ziya Hiçdurmaz]

Yanıt

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SON, SUT As Integer
If Intersect(Target, [C2]) Is Nothing Then Exit Sub
Application.EnableEvents = False
[A2:C2].Copy
SON = Sheets("tümcam").Cells(65536, "B").End(3).Row + 1
Sheets("tümcam").Cells(SON, "B").PasteSpecial xlValues
[A2:C2].Clear
For SUT = 1 To Sheets("tümcam").Cells(65536, "B").End(3).Row
Sheets("tümcam").Cells(SUT + 1, "A") = SUT
Next
Application.CutCopyMode = False
Application.EnableEvents = True
End Sub

 

[ekadak2000]

saolun bi deneyeyim

 

[ekadak2000]

yalnız hocam aktarılan yazının bir kopyasının yerinde kalmasını istiyorum

 

[N.Ziya Hiçdurmaz]

Yanıt

Renkli kısmı siliniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SON, SUT As Integer
If Intersect(Target, [C2]) Is Nothing Then Exit Sub
Application.EnableEvents = False
[A2:C2].Copy
SON = Sheets("tümcam").Cells(65536, "B").End(3).Row + 1
Sheets("tümcam").Cells(SON, "B").PasteSpecial xlValues
[COLOR="Red"][A2:C2].Clear[/COLOR]
For SUT = 1 To Sheets("tümcam").Cells(65536, "B").End(3).Row
Sheets("tümcam").Cells(SUT + 1, "A") = SUT
Next
Application.CutCopyMode = False
Application.EnableEvents = True
End Sub

 

[Orion1]

Ekli dosyayı inceleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte, sat As Long
On Error GoTo son
If Intersect(Target, [D3:D65536]) Is Nothing Then Exit Sub
If Cells(Target.Row, "B").Value <> "tümcam" Then Exit Sub
Set s1 = Sheets("tümcam")
If Cells(Target.Row, "B").Value = "" Then GoTo son
sat = s1.Cells(65536, "B").End(xlUp).Row + 1
s1.Cells(sat, "A").Value = sat - 1
For i = 2 To 4
    s1.Cells(sat, i).Value = Cells(Target.Row, i).Value
Next i
son:
Set s1 = Nothing
End Sub

 

[Erdal]

Sayın hocalarımız müsade ederse buda formülle yapılmış şekli

 

[Erdal]

dosyayı eklememişim

 

[ekadak2000]

saolun arkadaşlar