能不能把这段代码修改一下 从选择文件夹改成选择工作簿（根据工作簿多少可单选可多选）

Sub 获取文件夹()
Dim p$, f$, sh As Worksheet, R&, m&
With Application.FileDialog(4)
.Title = "选择文件夹"
.InitialFileName = Application.DefaultFilePath & "\"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
p = .SelectedItems(1) & "\"
End With
Application.ScreenUpdating = False
Set sh = ActiveSheet
p = ThisWorkbook.Path & "\"
f = Dir(p & "*.xlsx")
sh.UsedRange.Offset(3).ClearContents
Do While f <> ""
If f <> ThisWorkbook.Name Then
m = m + 1
If m = 1 Then R = 4 Else R = sh.Cells(sh.Rows.Count, 2).End(xlUp).Row + 1
With Workbooks.Open(p & f, 0)
.Sheets("成功").Range("4:" & .Sheets("成功").Cells(65536, 1).End(xlUp).Row).Copy sh.Cells(R, 1)
.Close False
End With
End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "哇塞，成功了!!!", 64, "提示"
End Sub

不是很懂你问题，我给你写了一个例子代码，你运行一下看看是不是你要的效果，然后把你的打开文件处理的代码添加到for each里面就可以了：
Sub 获取文件夹()
    Dim p
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "选择xxx工作薄(使用CTRL、SHIFT可多选)"
        .Filters.Clear
        .Filters.Add "EXCEL文件", "*.xls*"
        .Show
        For Each p In .SelectedItems
            MsgBox p
        Next p
    End With
End Sub

sub t() dim str str=thisworkbook.path msgbox right(str, len(str) - instrrev(str, "\")) end sub用路径整理下就是文件夹了啊~