Araç Servis Takip Programı (AST-v.2) foruma eklenmiştir. 
http://www.excelce.net/forum/index.php?topic=1656.0

Gönderen Konu: Veri al makrosuna ilave ricası  (Okunma sayısı 6905 defa)

0 Üye ve 1 Ziyaretçi konuyu incelemekte.

Çevrimdışı drummers

  • Excelce Onbaşı
  • **
  • İleti: 33
  • Puan +1/-0
  • Cinsiyet: Bay
  • VBA şifrelerine kıl oluyorum
  • Ad Soyad: ömür can
  • İl / İlçe: izmir
Veri al makrosuna ilave ricası
« : 13 Haziran 2011, 20:54:18 »
Sub Kontrol_Listesi_Aktar()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("data")
Set s2 = Sheets("kontrol")
s2.Range("c2:c200").Value = s1.Range("b2:b200").Value

End Sub


Üstteki makromda "data" sekmesindeki "b2:b200" aralığındaki verilerimi "kontrol" sekmeme aktarmaktayım.

İsteğim şudur: "data" sekmesindeki "b2:b200" aralığında bazı verilerimin renkleri "KIRMIZI" bu makroma eğer "b2:b200" aralığında kırmızı ile yazılmış veri varsa aktarma şartını ekliyebilirmiyiz.

Örnek dosya eklemeye gerek duymadım. Teşekkürler

Çevrimdışı Rami

  • Excelce Onbaşı
  • **
  • İleti: 64
  • Puan +1/-0
  • Cinsiyet: Bay
  • Excel'den Daha Fazlası!..
  • Ad Soyad: Kamil
  • İl / İlçe: Sivas
  • Mesleğiniz: İnşaat
Ynt: Veri al makrosuna ilave ricası
« Yanıtla #1 : 15 Haziran 2011, 01:40:32 »
Sub Kontrol_Listesi_Aktar()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("data")
Set s2 = Sheets("kontrol")
s2.Range("c2:c200").Value = s1.Range("b2:b200").Value

End Sub


Üstteki makromda "data" sekmesindeki "b2:b200" aralığındaki verilerimi "kontrol" sekmeme aktarmaktayım.

İsteğim şudur: "data" sekmesindeki "b2:b200" aralığında bazı verilerimin renkleri "KIRMIZI" bu makroma eğer "b2:b200" aralığında kırmızı ile yazılmış veri varsa aktarma şartını ekliyebilirmiyiz.

Örnek dosya eklemeye gerek duymadım. Teşekkürler

Anlatımınıza göre: aşağıdaki kod işinize yarayabilir.

Kod: [Seç]

For a = 1 To Cells(65000, 1).End(xlUp).Row
If Cells(a, 2).Interior.ColorIndex <> 3 Then
b = Sheets("kontrol").Cells(65000, 3).End(xlUp).Row + 1
Sheets("kontrol").Range("c" & b).Value = Sheets("data").Range("b" & a).Value
End If
Next
« Son Düzenleme: 15 Haziran 2011, 01:43:22 Gönderen: Rami »