Rearrange data without using Cut and Insert
To speed it up, I would read it into arrays. One array for column A and one array for column B and then combine them into another array and print that to sheet

Option Explicit
Sub Rearrange()
    Dim lastRow As Long
    lastRow = Library.Cells(Rows.Count, 1).End(xlUp).Row
    Dim firstColumn As Variant
    firstColumn = Library.Range("A1:A" &amp; lastRow)
    Dim secondColumn As Variant
    secondColumn = Library.Range("B1:B" &amp; lastRow)
    Dim totalCount As Long
    totalCount = Application.CountA(firstColumn) + Application.CountA(secondColumn)

    Dim combinedArray As Variant
    ReDim combinedArray(1 To totalCount)
    Dim i As Long
    Dim index As Long
    index = 1

    For i = 1 To lastRow
        combinedArray(index) = firstColumn(i, 1)
        index = index + 1
        If Not IsEmpty(secondColumn(i, 1)) Then
            combinedArray(index) = secondColumn(i, 1)
            index = index + 1
        End If
    Next

    Library.Range("A1:A" &amp; totalCount) = Application.Transpose(combinedArray)

End Sub


Arrays are fast!



Also, as you can see worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("Library") and instead just use Library.



I also switched your

lastRow = Library.Range("A1").SpecialCells(xlCellTypeLastCell).row


To the standard.



I also used a For loop instead of Do While.