Function FilterBoldNumeric() 'ByVal Rng As Range) '?FilterBoldNumeric(sayfa1.Range("A:A"))

    

    With ThisWorkbook.Sheets("Tum_Sayfa")

    LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row + 10

        .Range("A2:O" & LastRow).UnMerge

        .Range("A2:O" & LastRow).Clear

        .Cells.UseStandardHeight = True

        .Cells.UseStandardWidth = True

    End With



    Dim Rng As Range

    Dim Hucr As Range

    Dim HucrSon As Range

    Dim BytRng As Range

    Dim HcrByt As Range

    

    Set Rng = Sayfa1.Range("A:A")

    SonStr = Rng.Rows(Rng.Rows.Count).End(xlUp).Row 'burada sadece ilk sütundaki veriye bakar

    Set Rng = Rng.Worksheet.Range("A2:" & Rng.Rows(Rng.Rows.Count).End(xlUp).Address(0, 0))

    

    Dim BasRng As Range

    Dim KynkRng As Range

    Dim HdfRng As Range

    Dim StrRw As Long

    Dim AbcStn As Range, iCells As Range



Set HdfRng = ThisWorkbook.Sheets("Tum_Sayfa").Range("D")



    For Each Hucr In Rng

    If BasRng Is Nothing Then

        Set BasRng = Hucr

        GoTo 10

    End If

        If Hucr.Font.Bold = True And IsNumeric(Hucr.Value) = True Then

        StrRw = IIf(Hucr.Row < 3, 1, Hucr.Row - 2)

            

            SonStrHdf = HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).Row + 2

            SonStrHdf = IIf(SonStrHdf = 3, 2, SonStrHdf)

            

            Set UcStn = Rng.Worksheet.Range(BasRng.Address, Cells(BasRng.Row, "O").Address)

            UcStn.Borders.LineStyle = xlContinuous

            UcStn.Borders.Weight = xlThin

            

            HdfRng.Worksheet.Range("A" & SonStrHdf) = UcStn.Worksheet.Range("A" & UcStn.Row)

            HdfRng.Worksheet.Range("B" & SonStrHdf) = UcStn.Worksheet.Range("B" & UcStn.Row)

            HdfRng.Worksheet.Range("C" & SonStrHdf) = UcStn.Worksheet.Range("L" & UcStn.Row)

            

            Set IRange = HdfRng.Worksheet.Range("A" & SonStrHdf & ":" & "C" & SonStrHdf)



            For Each iCells In IRange

                iCells.BorderAround LineStyle:=xlContinuous, Weight:=xlThin

            Next iCells

            

            Set KynkRng = Rng.Worksheet.Range(BasRng.Address, Cells(StrRw, "O").Address)



            KynkRng.Copy

            HdfRng.Worksheet.Range("D" & SonStrHdf).PasteSpecial xlPasteAll

            

            Set KynkRng = KynkRng.Offset(, 11) 'L satırı için

            HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).RowHeight = KynkRng.Rows(KynkRng.Rows.Count).End(xlUp).Offset(1, -11).RowHeight

            Set BasRng = Hucr



        End If

10

    Next Hucr

        

        StrRw = IIf(BasRng.Row < 3, 1, BasRng.Row - 2)

            

            Set KynkRng = Rng.Worksheet.Range(BasRng.Address, Cells(SonStr, "O").Address)

            SonStrHdf = HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).Row + 2

            SonStrHdf = IIf(SonStrHdf = 3, 2, SonStrHdf)

            

            Set UcStn = Rng.Worksheet.Range(BasRng.Address, Cells(BasRng.Row, "O").Address)

            HdfRng.Worksheet.Range("A" & SonStrHdf) = UcStn.Worksheet.Range("A" & UcStn.Row)

            HdfRng.Worksheet.Range("B" & SonStrHdf) = UcStn.Worksheet.Range("B" & UcStn.Row)

            HdfRng.Worksheet.Range("C" & SonStrHdf) = UcStn.Worksheet.Range("L" & UcStn.Row)

            Set IRange = HdfRng.Worksheet.Range("A" & SonStrHdf & ":" & "C" & SonStrHdf)



            For Each iCells In IRange

                iCells.BorderAround LineStyle:=xlContinuous, Weight:=xlThin

            Next iCells

            

            KynkRng.Copy

            HdfRng.Worksheet.Range("D" & SonStrHdf).PasteSpecial xlPasteAll



            

            Set KynkRng = KynkRng.Offset(, 11) 'L satırı için

            HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).RowHeight = KynkRng.Rows(KynkRng.Rows.Count).End(xlUp).Offset(1, -11).RowHeight



With ThisWorkbook.Sheets("Tum_Sayfa")

For x = 1 To 15

    .Columns(x + 3).ColumnWidth = ThisWorkbook.Sheets("IVL").Columns(x).ColumnWidth

Next x

    .Columns(1).ColumnWidth = 10.14

    .Columns(2).ColumnWidth = 105.14

    .Columns(3).ColumnWidth = 9.14

    .Columns("A:C").Font.Bold = True

    .Columns(1).NumberFormat = "#,##0"



End With



Application.CutCopyMode = False



End Function