How to Sort Excel Sheets from Multiple Excel files in one folder

[mr.vasanth18]

Hi All,

I have multiple excel workbook ( 85) in one folder. Each workbook contain 13 sheets has same names with different order. Only Excel workbook name is different. Now I want to assign all workbook sheets in one order. Kindly note Its not assent or dissenting order. I had listed all workbook name with each sheets name using power query. Could you please provide any VBA for this, .

Ex
See the sample pic I had attached . If you need more details kindly ask me

 

[JLGWhiz]

Assuming the workbook running the code will be In the same folder as the 85 to be reorganized.

Sub t()
Dim fPath As String, fName As String, sh As Worksheet, wb As Workbook, ary As Variant
ary = Array("Unit", "Area", "Filed", "Location", "Group", "Main", "Material", "Part", "Design", "Cost", "Outboard", "Temporary", "Final")
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*.xls*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(fPath & fName)
            For i = LBound(ary) To UBound(ary) - 1
                On Error Resume Next
                    Sheets(ary(i + 1)).Move After:=Sheets(ary(i))
                On Error GoTo 0
                Err.Clear                
            Next
            wb.Close True
       End If
       fName = Dir
    Loop
End Sub

 

[lrobbo314]

Same idea using FSO.

Sub ARRANGE()
Application.ScreenUpdating = False
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Fold As Object: Set Fold = FSO.getfolder("C:\Users\USERNAME\Desktop\Files")
Dim wb As Workbook
Dim AR() As Variant: AR = Array("Unit", "Area", "Filed", "Location", "Group", "Main", "Material", "Part", "Design", "Cost", "Outboard", "Temporary", "Final")

For Each xlFile In Fold.Files
    Set wb = Application.Workbooks.Open(xlFile)
    For i = 0 To UBound(AR)
        wb.Sheets(AR(i)).Move before:=Sheets(i + 1)
    Next i
    wb.Close True
Next xlFile

Application.ScreenUpdating = True
End Sub

 

[mr.vasanth18]

Assuming the workbook running the code will be In the same folder as the 85 to be reorganized.

Sub t()
Dim fPath As String, fName As String, sh As Worksheet, wb As Workbook, ary As Variant
ary = Array("Unit", "Area", "Filed", "Location", "Group", "Main", "Material", "Part", "Design", "Cost", "Outboard", "Temporary", "Final")
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*.xls*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(fPath & fName)
            For i = LBound(ary) To UBound(ary) - 1
                On Error Resume Next
                    Sheets(ary(i + 1)).Move After:=Sheets(ary(i))
                On Error GoTo 0
                Err.Clear               
            Next
            wb.Close True
       End If
       fName = Dir
    Loop
End Sub

Thank you so much.

 

[mr.vasanth18]

Same idea using FSO.

Sub ARRANGE()
Application.ScreenUpdating = False
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Fold As Object: Set Fold = FSO.getfolder("C:\Users\USERNAME\Desktop\Files")
Dim wb As Workbook
Dim AR() As Variant: AR = Array("Unit", "Area", "Filed", "Location", "Group", "Main", "Material", "Part", "Design", "Cost", "Outboard", "Temporary", "Final")

For Each xlFile In Fold.Files
    Set wb = Application.Workbooks.Open(xlFile)
    For i = 0 To UBound(AR)
        wb.Sheets(AR(i)).Move before:=Sheets(i + 1)
    Next i
    wb.Close True
Next xlFile

Application.ScreenUpdating = True
End Sub

Thanks you SO much. I can use this both VBA. Thanks lot

 

[JLGWhiz]

You're welcome,
Regards, JLG