Biçimlendirilmiş Sütunu Değer olarak kopyalamak

[veterinerhekim]

Merhaba arkadaşlar şu duruma bir çözüm bulamadım. Bir sütun hazırladım buraya isteğe bağlı biçimlendirme yaptım:

Biçimlendirmem şu şekilde:
T\R32000000000

Sütuna şu rakamı yazdığımda :1393258
Biçimlendirme sayesinde karşıma TR32001393258 şeklinde çıkmaktadır.

Benim istediğim sütuna bu şekilde TR li dönüştürülmüş halini DEĞER olarak kopyalamak. Tüm kopyalama seçenekleri TR li olarak değer olarak yapıştırmamaktadır. Bu işlemi yapabilmek için hazırladığım sütunu worde kopyalıyorum sonra ordan istediğim sütuna yapıştırıyorum. Ancak bu şekilde TR li olarak değer olarak yapıştırabiliyorum.

Bu konuda şöyle bir makro var ama bunda sorun oluyor.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells, cel As Range
    Set KeyCells = Range("f2:f" & Rows.Count)
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
        
       For Each cel In Target
                
                If cel <> "" Then
                
                With cel
                .Offset(0, -4) = "TR3200" & cel
                End With
                Else
                With cel
                .Offset(0, -4) = ""
                End With
                End If
              
       Next
    End If
End Sub

Ancak bu kodda sorun şöyle: Bazı rakamlar TR32000123123 şeklinde tr den sonra 3 tane sıfır var, bazı rakamlar ise TR32001231231 şeklinde sorun burda başlıyor makro istediğim yere hep 2 tane sıfırlı olarak yapıştırmakta. kodda düzenleme bir türlü yapamadım.

 

[ÖmerBey]

Merhaba,
Koddaki ilgili yeri şu şekilde düzenleyip deneyiniz.

With cel
.Offset(0, -4) = cel[COLOR="Red"].Text[/COLOR]
End With

 

[veterinerhekim]

Merhaba,
Koddaki ilgili yeri şu şekilde düzenleyip deneyiniz.

With cel
.Offset(0, -4) = cel[COLOR="Red"].Text[/COLOR]
End With

Teşekkür ederim. Aradığım buydu

Hocam makroya şöyle bir şey ekleyebilir miyiz? F10 dan F1000 e kadar sütunu B10 dan B1000 e kadar kopyalama gerçekleşiyor. Bu makroya şu eklenir mi?

G10 dan G1000 E Kadar
H10 dan H1000 e Kadar
I10 dan I1000 e Kadar olan biçimlendirilmiş olanlarda aynı şekilde

B10 dan B1000 e kadar kopyalama yapabilir mi?

Burada hata oluşmaması adına Diyelim G15 TRli rakam yazılırsa F-H-I(15) Bloklanabilir mi?

Çalışma:

 

[ÖmerBey]

Aşağıdaki kodu kullanabilirsiniz.

Sub kod()
For a = 10 To 1000
    For b = 6 To 9
        If Cells(a, b) <> "" Then
            If Left(Cells(a, b).Text, 2) = "TR" Then
                Cells(a, "B") = Cells(a, b).Text
                Exit For
            End If
        End If
    Next
Next
End Sub

F-I sütunlarına veri doğrulama uygulayarak birden fazla hücreye veri girilmesini engelleyebilirsiniz.
İyi çalışmalar...

 

[veterinerhekim]

Kodu yapıştırdım fakat makro sürekli aktif değil play yapmak gerekiyor. Makroda bilgim olmadığı için nasıl sürekli aktif yapılıyor bilmiyorum.

Son olarak veri doğrulamayı nasıl yapabilirim?

 

[veterinerhekim]

Hocam bir sorum daha olacak Yazdırma Alanı Sonu (Sınırlandırması için) örneğin b sütunun veri girişi olan en son satırına kadar yazdırma sayfa sonu olarak ayarlanması için pratik bir kod çözüm var mıdır? Her sayfa için en alta inip yukarıya kadar çekmek baya bi zaman alıyor.