Option Explicit
Sub ExcelExp_Short_Dataconclusion()
Dim wksWorksheet As Worksheet
For Each wksWorksheet In ActiveWorkbook.Worksheets
If wksWorksheet.Visible <> xlSheetVisible Then wksWorksheet.Delete
Next wksWorksheet
Dim wsNew As Worksheet
Set wsNew = Worksheets.Add
With wsNew
.Name = "Data"
.Move after:=Sheets(Sheets.Count)
End With
Set wsNew = Nothing
Dim ws As Worksheet
Dim X As Integer
X = 1
With ActiveWorkbook.Sheets("Data")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Data" Then
.Cells(1, X) = ws.Name
ws.Range("E5:E77").Copy
.Cells(2, X).PasteSpecial xlPasteValues
ws.Range("O5:O77").Copy
.Cells(2, X + 1).PasteSpecial xlPasteValues
X = X + 2
End If
Next ws
End With
End Sub