Function VeriAktar()



'hy_______________________________________Sayfa Resetleme

    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

'hy________________________________________BİTTİ

Dim Aralik() As Variant

Dim Rng As Range, Hucr As Range

Dim AnaSht As Worksheet, HdfSht As Worksheet





    Set AnaSht = ThisWorkbook.Sheets("IVL")

    Set HdfSht = ThisWorkbook.Sheets("Tum_Sayfa")

    

    Set Rng = AnaSht.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:A" & SonStr)



'hy___________________________________________________________________Bold IVL değerlerinin adresleri diziye aktarıldı

    For Each Hucr In Rng

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

            ReDim Preserve Aralik(x)

            Aralik(x) = Hucr.Row

            x = x + 1

        End If

    Next Hucr

            ReDim Preserve Aralik(x)

            Aralik(x) = SonStr + 2

'hy___________________________________________________________________BİTTİ

    



Dim KynkRng As Range

Set HdfRng = HdfSht.Range("D")

'hy_________________________________________________________________________Veri AKtarma

For x = LBound(Aralik) To UBound(Aralik) - 1

    Set KynkRng = AnaSht.Range("A" & Aralik(x) & ":O" & Aralik(x + 1) - 2)

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

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

        KynkRng.Copy

        HdfSht.Range("D" & SonStrHdf).PasteSpecial xlPasteAll

        SonStrHdf2 = HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).Row

    Set KynkRng = KynkRng.Offset(, 11)

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



            HdfSht.Range("A" & SonStrHdf) = AnaSht.Range("A" & Aralik(x))

            HdfSht.Range("B" & SonStrHdf) = AnaSht.Range("B" & Aralik(x))

            HdfSht.Range("C" & SonStrHdf) = AnaSht.Range("L" & Aralik(x))

            HdfRng.Worksheet.Range("A" & SonStrHdf).Interior.ColorIndex = 3

            HdfRng.Worksheet.Range("D" & SonStrHdf & ":O" & SonStrHdf2).Interior.ColorIndex = 3



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



            For Each iCells In IRange

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

            Next iCells

Next x



'hy__________________________"Tum_Sayfa" düzenleme

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

MsgBox "İşlem Tamam"

End Function