YAZI karakteri belirlemede ACİL YARDIM

[atalayozatav]

Merhaba,

Sayfalar arası koşullu olarak veri transferi yapmaktayım, Yazı karakteri kalınlıgı vb özellikleri belirlemek istemekteyim. Yaşadığım problem koşula göre bazen "B13" bazende "B250" hücresinin yazı karakterini değiştirmek istediğimden ve üste kalan verilere ellemek istemediğimden kaynaklanmaktadır. hatayı ve komple kodu eke koydum yardımcı olursanız sevınırım.

Sub FORMU_DOLDUR()
    Dim LastRow As Long
    Dim minX, minY, minZ, maxX, maxY, maxZ As Long
    Dim islemeMetodu, malzemeKodu As String
    Dim toplamAdet As Integer
          
    LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
    Range("A15:F" & LastRow).ClearContents
    
    minX = Cells(2, "J").Value
    minY = Cells(3, "J").Value
    minZ = Cells(4, "J").Value
    maxX = Cells(2, "K").Value
    maxY = Cells(3, "K").Value
    maxZ = Cells(4, "K").Value
    malzemeKodu = Cells(10, "C").Value
    islemeMetodu = Cells(11, "C").Value
    'yukaridaki parametrelere gore ana listeden filtreleme yapacagiz
    Set dataSheet = Sheets("P-XXX")
    LastRow = dataSheet.Cells(dataSheet.Rows.Count, "B").End(xlUp).Row
    Set dSource = dataSheet.Range("A20:P" & LastRow)
    Set parcalar = dataSheet.Range("A20:P" & LastRow)
    Dim i As Integer
    i = 15
    toplamAdet = 0
    
    For Each r In parcalar.Rows
        If Not islemeMetodu = Empty And islemeMetodu <> r.Cells(5).Value Then
            GoTo Skip
        ElseIf Not malzemeKodu = Empty And malzemeKodu <> r.Cells(8).Value Then
            GoTo Skip
        ElseIf Not minX = Empty And minX > r.Cells(14).Value Then
            GoTo Skip
        ElseIf Not minY = Empty And minY > r.Cells(15).Value Then
            GoTo Skip
        ElseIf Not minZ = Empty And minZ > r.Cells(16).Value Then
            GoTo Skip
        ElseIf Not maxX = Empty And maxX < r.Cells(14).Value Then
            GoTo Skip
        ElseIf Not maxY = Empty And maxY < r.Cells(15).Value Then
            GoTo Skip
        ElseIf Not maxZ = Empty And maxZ < r.Cells(16).Value Then
            GoTo Skip
        End If
        
        Cells(i, "A").Value = i - 14
        Cells(i, "B").Value = r.Cells(2).Value
        Cells(i, "C").Value = r.Cells(10).Value
        Cells(i, "D").Value = r.Cells(14).Value
        Cells(i, "E").Value = r.Cells(15).Value
        Cells(i, "F").Value = r.Cells(16).Value
        toplamAdet = toplamAdet + r.Cells(10).Value
        i = i + 1
Skip:
    Next
            
    i = i + 1
        Cells(i, "B").Value = "Toplam Adet"
        Cells(i, "C").Value = toplamAdet
        Range(i, "B").Font.Size = 15
    i = i + 2
        Cells(i, "C").Value = "ONAY"
    i = i + 1
        Cells(i, "B").Value = "SATIN ALMA KABUL"
    i = i + 2
        Cells(i, "B").Value = "TEKNİK KABUL"
    i = i + 2
        Cells(i, "B").Value = "NOT"
    
End Sub