Makro'da Düzenleme

[1Al2Ver]

Merhabalar,

Ek'li dosyadaki makroda bir düzenlemeye ihtiyacım var.

Teşekkür ederim.

Sub aktar_Rapor()
Set s1 = Sheets("işlem")
Set s2 = Sheets("Rapor")
For i = 10 To s1.[A65536].End(3).Row
f = s2.[A65536].End(3).Row + 1
s2.Cells(f, 1).Value = s1.Cells(3, "b").Value
For s = 2 To 9
s2.Cells(f, s + 1).Value = s1.Cells(i, s).Value
Next
Next
Range("A10:D29,F10:F29,H10:I29").Select
    Selection.ClearContents
    Range("A2").Select
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

 

[Ömer BARAN]

Merhaba.

Hatalı cevap düzeltmesi.

Belgedeki istediğiniz formatı yeni fark ettim.
Mevcut kod'u aşağıdaki ile değiştirmeniz sanırım yeterli olacaktır.
.

[FONT="Arial Narrow"]Sub aktar_Rapor()
Set s1 = Sheets("İŞLEM")
Set s2 = Sheets("RAPOR")
        
yemekno = WorksheetFunction.Max(s2.Range("A16:A" & s2.[C65536].End(3).Row - 1)) + 1
s2.Cells(s2.[C65536].End(3).Row + 1, 1) = yemekno
s2.Cells(s2.[C65536].End(3).Row + 1, 2) = s1.[B3]

For i = 10 To s1.[A65536].End(3).Row
    f = s2.[C65536].End(3).Row + 1
        s2.Cells(f, 3) = s1.Cells(i, "b").Value
    For s = 3 To 9
        s2.Cells(f, s + 1).Value = s1.Cells(i, s).Value
    Next
Next
Range("A10:D29,F10:F29,H10:I29").Select
    Selection.ClearContents
    Range("A2").Select
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation

End Sub[/FONT]

 

[1Al2Ver]

Teşekkür ederim sayın Ömer BARAN,

Elinize sağlık, zahmet etmiş uğraşmış sınız.

Resimdeki gibi olabilme imkanı var mı ?

 

[Ömer BARAN]

Yukarıdaki kod'da MsgBox satırından önce Call BİÇİM şeklinde bir satır ekleyin
ve aşağıdaki kod'u İŞLEM sayfasının kod bölümünde en alta yapıştırın.
Sanırım istediğiniz gibi oluyor, deneyiniz.

[FONT="Arial Narrow"]Sub BİÇİM()
Set s2 = Sheets("RAPOR")
Set s2 = Sheets("RAPOR")
s2.Cells.FormatConditions.Delete
s2.Range("A" & s2.[C65536].End(3).Row & ":I" & s2.[C65536].End(3).Row).Borders(xlBottom).LineStyle = xlContinuous
alan1 = "A17:I" & s2.[C65536].End(3).Row
s2.Range(alan1).FormatConditions.Add Type:=xlExpression, Formula1:="=$A17>0"
s2.Range(alan1).FormatConditions(s2.Range(alan1).FormatConditions.Count).SetFirstPriority
s2.Range(alan1).FormatConditions(1).Borders(xlTop).LineStyle = xlContinuous
s2.Range(alan1).FormatConditions(1).StopIfTrue = True

alan2 = "A17:I" & s2.[C65536].End(3).Row
s2.Range(alan2).FormatConditions.Add Type:=xlExpression, Formula1:="=$C17<>"""""
s2.Range(alan2).FormatConditions(s2.Range(alan2).FormatConditions.Count).SetFirstPriority
s2.Range(alan2).FormatConditions(1).Borders(xlRight).LineStyle = xlContinuous
s2.Range(alan2).FormatConditions(1).Borders(xlLeft).LineStyle = xlContinuous

s2.Range(alan2).FormatConditions(1).StopIfTrue = False

    s2.Range("A17:I" & s2.[C65536].End(3).Row).Font.Size = 8
    s2.Range("A17:I" & s2.[C65536].End(3).Row).HorizontalAlignment = xlGeneral
    s2.Range("I17:I" & s2.[C65536].End(3).Row).NumberFormat = "#,##0_ ;[Red]-#,##0 "
    s2.Range("E17:E" & s2.[C65536].End(3).Row).NumberFormat = "#,##0_ ;[Red]-#,##0 "
    s2.Range("G17:H" & s2.[C65536].End(3).Row).NumberFormat = "#,##0.00_ ;-#,##0.00 "
    s2.Range("F17:F" & s2.[C65536].End(3).Row).NumberFormat = "#,##0.000_ ;-#,##0.000 "
    s2.Range("D17:D" & s2.[C65536].End(3).Row).HorizontalAlignment = xlCenter
End Sub[/FONT]

 

[1Al2Ver]

Sayın Ömer BARAN merhaba, hayırlı sabahlar dilerim,

Emeğinize sağlık, ayrıca ilginiz ve nezaketiniz için de teşekkür ederim.

Saygılarımla.

 

[Ömer BARAN]

Estağfurulluh, önemli olan ihtiyacın görülmesi.
İyi günler, kolaylıklar dilerim.