DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
valla bizimkide baykalla erdogan atısması gıbı oldu ama sonu iyi bitti haluk bey cim bizden örnek almalılar benceSana da iyi geceler yakup123cüğüm ...
çok tesekkur ederım guzel bi ornek
for i = 2 to 100
sheets("1").select
on error goto ekle:
sheets("1").range("b:b").find(sheets("2").cells(i,2)).select
activecell.offset(0,4) = sheets("2").cells(i,2)
ekle:
sheets("1").range("b1048576").end(3).offset(1,0) = sheets("2").cells(i,2)
next i
Merhaba Ömer Bey,Merhaba,
Dosyanızı incelemedim.
ekle:
kodundan önce
exit sub
yazarak deneyin. İstediğiniz bu sanırım. Eğer istediğiniz farklı bir şeyse kodları bir kenara bırakıp yapmak istediğiniz açıklarmısınız.
Sub OkuYazDegistir()
Dim ShV As Worksheet, _
ShH As Worksheet, _
c As Range, _
i As Long, _
Sat As Long
Application.ScreenUpdating = False
Set ShV = Sheets("VERİ")
Set ShH = Sheets("H")
Sat = ShV.Cells(Rows.Count, "B").End(3).Row
For i = 2 To Cells(Rows.Count, "B").End(3).Row
Set c = ShV.Range("B:B").Find(ShH.Cells(i, "B"), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
ShV.Cells(c.Row, "F") = ShH.Cells(i, "F")
ShV.Cells(c.Row, "G") = ShH.Cells(i, "G")
Else
Sat = Sat + 1
ShV.Cells(Sat, "B") = ShH.Cells(i, "B")
ShV.Cells(Sat, "F") = ShH.Cells(i, "F")
ShV.Cells(Sat, "G") = ShH.Cells(i, "G")
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır...."
End Sub
a.cells(c,"F").font.bold = true
a.cells(c,"G").colorindex = 10
Çok teşekkür ederim, Necdet Bey.Merhaba,
a.cells(c,"G").Font.ColorIndex = 3
şeklinde kullanırsanız font rengini verirsiniz.
a.cells(c, "G").interior.colorindex = 3 derseniz arka plan rengini verirsiniz.