Hi protonLeah,

I attempted to modify your code to delete only the rows of Sheet Four from Row 3 down but my "fix" caused an error with the last line of code, which I also modified. I fear I have made matters worse. I also need to sort the result.

Help, please! And thank you. 

Sub Collimator2()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Four")
    Dim HolderArray As Variant, _
        temp1       As Variant, _
        TabNames    As Variant, _
        TabPicker   As Variant, _
        MaxRow      As Long, _
        LastRow     As Long
        
    TabNames = Array("one", "two", "three")
    ws.UsedRange.Offset(2).EntireRow.Delete
    For Each TabPicker In TabNames
        LastRow = Sheets(TabPicker).UsedRange.Rows.Count
        MaxRow = IIf(LastRow > MaxRow, LastRow, MaxRow)
    Next TabPicker
    
    For LastRow = 0 To 2
        temp1 = Sheets(TabNames(LastRow)).Range("A2:A" & MaxRow).Value
        temp1 = WorksheetFunction.Transpose(temp1)
        HolderArray = HolderArray & Join(temp1, ",")
    Next LastRow
    HolderArray = Split(HolderArray, ",")
    HolderArray = WorksheetFunction.Transpose(HolderArray)
    Sheets("four").Range("A1").Resize(rowsize:=UBound(HolderArray)).Value = HolderArray
    Sheets("four").Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks).Delete
End Sub