Özellikleri ile kopyalama

[Tevfik_Kursun]

Merhaba Arkadaşlar,

Bu çalışmada Smltr!AJ17 de belirtilen alandaki verilerin renklendirilmesini Koşullu Biçimlendirme ile 36 formül yardımıyla yaptım. AK18:BN18 arasındaki rakamlara bağlı olarak ve AK22:BN22 arasında Y harfine göre koşullu biçimlendirme yapıldı.
Bu 1 kişi için. Daha 1000 den fazla isim var. Belki makro ile bir yol olabilir mi?

Smltr!AJ17 de belirtilen alandaki veriler, renkleri, fontları ve hücre genişlik ve yüksekliği ile, Ozet!B8 de belirtilen alana kopyalayacağım. Ancak değerleri renksiz olarak alabildim.

Yardımcı olursanız sevinirim.
Saygılarımla

 

[Tevfik_Kursun]

Merhaba Arkadaşlar,

Sub kopyala59()
Dim sh As Worksheet
    Set sh = Sheets("Ozet")
        sh.Range("AJ19:BN21").Clear
        Range("D8:AH10").Copy sh.Range("D8")
    sh.Select
' MsgBox "veriler kopyalandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

daha önce aynı başlık altında aynı soruyu sormuştum. Sanırım benim bakmadan sorduğumu sandınız. Burada koşullu biçimlendirme var. Muhtemelen ben bir yerde hata yapıyorum, ama nerede?
Saygılarımla

 

[Ömer BARAN]

Merhaba.

Aşağıdaki gibi olabilir.

Varsayım ise iki alanın ilk hücreleri arasındaki satır farkı ve sütun farkıyla ilgili:
kaynak satır ve sütun numaralarının hedef satır/sütun numaralarından büyük olduğu.
(AJ19'un satır no:19, sütun no: 36 // D8'in satır no:8, sütun no: 4)

Elbette bu varsayım da;
kod'da bu satır sütun ikililerinin büyük ve küçüğünü MAX ve MIN işlevlerini kullanarak ayırıp farklarını alarak giderilebilir.
.

[B]Sub kopyala_brn()[/B]
Set o = Sheets("Ozet"): Set s = Sheets("Smltr")
o.Range(o.[B8].Value).Clear
s.Range(s.[AJ17].Value).Copy: o.Range(o.[B8].Value).PasteSpecial Paste:=xlPasteValues
[B][COLOR="Blue"]satfark[/COLOR][/B] = Range((Split(Mid(s.[AJ17], WorksheetFunction.Search("!", s.[AJ17]) + 1, 255), ":")(0))).Row - _
        Range(o.[B8].Value).Row
[B][COLOR="Red"]sutfark[/COLOR][/B] = Range((Split(Mid(s.[AJ17], WorksheetFunction.Search("!", s.[AJ17]) + 1, 255), ":")(0))).Column - _
        Range(o.[B8].Value).Column
For Each hcr In o.Range(o.[B8].Value)
    With s.Cells(hcr.Row + [B][COLOR="Blue"]satfark[/COLOR][/B], hcr.Column + [B][COLOR="Red"]sutfark[/COLOR][/B])
        hcr[B].Interior.ColorIndex[/B] = .DisplayFormat.Interior.ColorIndex
        hcr[B].Font.Color[/B] = .DisplayFormat.Font.Color
        hcr[B].Font.Size[/B] = .DisplayFormat.Font.Size
        hcr[B].Borders.LineStyle[/B] = .DisplayFormat.Borders.LineStyle
        hcr[B].ColumnWidth[/B] = .ColumnWidth
        hcr[B].HorizontalAlignment[/B] = .HorizontalAlignment
    End With
Next
MsgBox "Veriler, biçimleriyle birlikte kopyalandı.", vbInformation, "..::.. Ömer BARAN ..::.."
[B]End Sub[/B]

 

[Tevfik_Kursun]

Sayın Ömer Baran Hocam,
İlginize çok teşekkür ederim.
Saygılarımla