Soru Makro ile Kosullu Satir Bul- Degistir , Kopyala yapistir..

[canburak]

Merhaba Hocam,
Assagidaki makroya uyarlama yapmaya calistim ama olmadi, yapmak Istedigim A10:A stununda bulunan veri A7 hucresinde ki veriye esit ise A7:R7 Hucrelerini kopyalayip A10:A sutununda ki A7 hucresine esit olan satira gidip yapistirmasi ama birturlu beceremedim.

Saygilarimla,

Sub Degistir()

Dim s1 As Worksheet
Dim Sat As Long

Set s1 = Sheets("Entry")
Sat = s1.Cells(Rows.Count, "A").End(3).Row

If WorksheetFunction.CountIf(s1.Range("A10:A" & s1.Rows.Count), s1.Range("A7")) = 0 Then
s1.Range("A7:R7").Copy
s1.Range("A10" & Sat).PasteSpecial
End If
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Verileri alana sadece değer olarak aktaracaktır.

Option Explicit

Sub Aktar()
    Dim Bul As Range, Adres As String, Say As Long
    
    Set Bul = Range("A10:A" & Rows.Count).Find(Range("A7"), , , xlWhole)
    
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
            Say = Say + 1
            Bul.Resize(, 18).Value = Range("A7:R7").Value
            Set Bul = Range("A10:A" & Rows.Count).FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
    
    Set Bul = Nothing
    
    MsgBox Say & " adet veri aktarımı yapılmıştır.", vbInformation
End Sub

 

[canburak]

Deneyiniz.

Verileri alana sadece değer olarak aktaracaktır.

Option Explicit

Sub Aktar()
    Dim Bul As Range, Adres As String, Say As Long
   
    Set Bul = Range("A10:A" & Rows.Count).Find(Range("A7"), , , xlWhole)
   
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
            Say = Say + 1
            Bul.Resize(, 18).Value = Range("A7:R7").Value
            Set Bul = Range("A10:A" & Rows.Count).FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
   
    Set Bul = Nothing
   
    MsgBox Say & " adet veri aktarımı yapılmıştır.", vbInformation
End Sub

Hocam Elinize saglik cok guzel calisiyor, Tesekkur ederim.

Sayglilarimla,