Zor bir makro Lazım

[batman53]

a1-------------------a2---------------a3
BİLGİSAYAR----------20---------------BİLGİSAYAR
araba----------------30---------------BİLGİSAYAR
ev-------------------40---------------BİLGİSAYAR
KÖŞK----------------50---------------KÖŞK


istediğim makro birinci sütunda yazılar var. İkinici sütunda sayılar. 1. sütundaki yazının tamamı büyük karakterle yazılmışsa, a3 de aynı yazıya sahip olacak. Ama a1 küçük karakterlerle yazılmışsa, bir üstteki yazı alta yazılacak. a1 de yine Tamamı büyük karakterle yazılmış yazı olursa, a3 de o yazı gözükecek. Bu böyle yazı bitene kadar devam edecek.

Yardımlarınızı bekliyorum

 

[batman53]

Sub deneme()
Dim x As Long
For x = 2 To [a10000].End(3).Row
If Cells(x, 1) = "" Then
GoTo gel
ElseIf Cells(x, 1).Font.Color = vbRed Then
Cells(x, 2) = Cells(x, 1)
Else
Cells(x, 2) = Range("b" & x).End(3).Value
End If
gel:
Next x
End Sub

gibi bir makro vardı elimde ama yazı kırmızı renk olduğunda çalışmak için yazılmıştı.

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub kopya()
For i = 2 To Cells(Rows.Count, 1).End(3).Row
If Cells(i, 1) = UCase(Cells(i, 1)) Then
Cells(i, 3) = Cells(i, 1)
Else
Cells(i, 3) = Cells(i - 1, 3)
End If
Next
End Sub

 

[batman53]

Çok sağolun.

İlgilendiğiniz için sağolun. İşe yaradı