Verileri Tabloda Uygun yere Koyma

[ANTALYA 01]

Merhabalar

Ekteki çalışmada ana_sayfa Sayfasındaki O sütunundan S sütununa kadar Sütunlara T Sütununa bakarak illgili alanlara X İşareti koyacak ve Sayfa 1 Sayfasından R sütunundaki verilere göre ana_sayfa sayfasındaki V sütunundan AA Sütununa kadar olan sütunlara X İŞareti koyacak makroya ihtiyacım bulunmaktadır.Detaylı bilgiyi Hücrelere yazdım.Tşk.ler.

 

[fedeal]

denermisiniz,

Sub fedeal()
son = Range("t65536").End(3).Row
For i = 2 To son
If Cells(i, "t").Value = "PEŞİN ÖDEME" Then
Cells(i, "O").Value = "X"
Cells(i, "q").Value = "X"
Cells(i, "r").Value = "X"
Else
Cells(i, "O").Value = "X"
Cells(i, "q").Value = "X"
Cells(i, "s").Value = "X"
End If
Next
On Error Resume Next
son1 = Sheets("sayfa1").Range("r65536").End(3).Row
For i = 5 To son1
bul = Sheets("sayfa1").Cells(i, "r").Find("pazartesi")
If bul <> Empty Then Cells(i - 3, "v").Value = "x"
bul = Sheets("sayfa1").Cells(i, "r").Find("salı")
If bul <> Empty Then Cells(i - 3, "w").Value = "x"
bul = Sheets("sayfa1").Cells(i, "r").Find("çarşamba")
If bul <> Empty Then Cells(i - 3, "x").Value = "x"
bul = Sheets("sayfa1").Cells(i, "r").Find("perşembe")
If bul <> Empty Then Cells(i - 3, "y").Value = "x"
bul = Sheets("sayfa1").Cells(i, "r").Find("cuma")
If bul <> Empty Then Cells(i - 3, "z").Value = "x"
bul = Sheets("sayfa1").Cells(i, "r").Find("cumartesi")
If bul <> Empty Then Cells(i - 3, "aa").Value = "x"
Next
End Sub

 

[ANTALYA 01]

J

Merhaba
Tek kelimeyle mükemmel olmuş.Teşekkür ederim.

 

[fedeal]

Merhaba
Tek kelimeyle mükemmel olmuş.Teşekkür ederim.

Aslında değil degerler degişince eskileri silmedigi için hatalı olacak onun için kodların başına

SON = Range("t65536").End(3).Row
Range("R2:S" & SON).ClearContents
Range("V2:AA" & SON).ClearContents

bu satırları ekleyin,iyi çalışmalar.