Copy data from multiple sheets

Here's my take on this process:

Option Explicit

Sub Consolidate()
Dim OutSH   As Worksheet
Dim ws      As Worksheet

Set OutSH = Sheets("All")
OutSH.Cells.ClearContents
OutSH.Range("A1:H1").Value = Array("Employee ID", "Employee Name", "", "Fund", "", "Accounting Unit", "", "Account Number", "Mileage")
  
    For Each ws In Worksheets
        If ws.Name <> OutSH.Name And ws.Name <> "ByDept" Then _
            OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 10).Value = _
                ws.Cells(80, 2).Resize(1, 10).Value
    Next ws

OutSH.Range("A:A").ClearContents
OutSH.Columns.AutoFit
Set OutSH = Nothing

End Sub

Thank you very much! It works beatifully!

If that takes care of your need, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED.