第一个问题解决了，第二个就比较简单了，谢谢！！！

Sub Macro1()
    Dim MyPath$, MyName$, arr, sh As Worksheet, d As Object, i&
    Set d = CreateObject("scripting.dictionary")
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath & "*.xls")
    Application.ScreenUpdating = False
    Do While MyName <> ""
        If MyName <> ThisWorkbook.Name Then
            With Workbooks.Open(MyPath & MyName)
                With .Sheets(1)
                    arr = .Range(.[a1], .[IV1].End(1))
                End With
                For i = 2 To UBound(arr, 2)
                    d(arr(1, i)) = i
                Next
                For Each sh In .Sheets
                    If sh.Name <> .Sheets(1).Name Then
                        With sh
                            With .Range("A1").CurrentRegion
                                arr = .Value
                                .Offset(0, 1).ClearContents
                            End With
                            For i = 2 To UBound(arr, 2)
                                .Cells(1, d(arr(1, i))).Resize(UBound(arr)) = WorksheetFunction.Index(arr, 0, i)
                            Next
                        End With
                    End If
                Next
                .Close True
            End With
            d.RemoveAll
        End If
        MyName = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "完毕"
End Sub