You could use this macro:
Sub Macro1()
Dim mySh As Worksheet
Dim repSh As Worksheet
Dim lastRow As Long, r As Long, destRow As Long
Dim i As Integer, c as Integer
Set repSh = ThisWorkbook.Sheets("report")
repSh.Range("2:" & Rows.Count).ClearContents
destRow = 1
Application.ScreenUpdating = False
For Each mySh In ThisWorkbook.Sheets
If Not LCase(mySh.Name) Like "*report*" Then
lastRow = mySh.Cells(Rows.Count, "a").End(xlUp).Row
For r = 2 To lastRow
For i = 1 To Len(mySh.Cells(r, 1)) Step 4
destRow = destRow + 1
repSh.Cells(destRow, 1) = Mid(mySh.Cells(r, 1), i, 3)
for c=2 to 7 'columns B-G
repSh.Cells(destRow, c) = mySh.Cells(r, c)
next c
Next i
Next r
End If
Next mySh
'sort data
With repSh
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A2:A" & lastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("B2:B" & lastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:G" & lastRow)
.Header = xlYes
'.MatchCase = False
'.Orientation = xlTopToBottom
'.SortMethod = xlPinYin
.Apply
End With
End With
Application.ScreenUpdating = False
End Sub
Regards,
Antonio
Bookmarks