跪求，如何将指定文件夹下一份份单独的EXCEL文件中的某一行或几行的数据全部合并到一个工作表中呢

哪位大侠可不可以写个这样的代码，里面的数据所在的行数我自己修改

'将多个工作簿放在同一文件夹下，其中有一个放VBA代码的工作簿
Sub UnionWorksheets()
Dim lj As String
Dim dirname As String
Dim nm As String
Dim Sht As Worksheet
Dim Str As String
lj = ActiveWorkbook.Path '查找工作簿
nm = ActiveWorkbook.Name
dirname = Dir(lj & "\*.xls")
m = 0
Do While dirname <> ""
If dirname <> nm Then
Workbooks.Open Filename:=lj & "\" & dirname '打开一个工作簿
For Each Sht In Worksheets '遍历工作表
Rows("1:3").Select '选择1-3行拷贝
Selection.Copy
Workbooks(1).Activate '拷贝到目标工作簿,根据要求设置
Range("A65536").End(xlUp).Select '目标工作簿工作表1A列最后一行
ActiveSheet.Paste
Application.CutCopyMode = False '清除剪贴板内容
Workbooks(2).Activate
Next
Workbooks(dirname).Close False
End If
dirname = Dir
Loop
End Sub

='C:\新建文件夹\[工作簿名.xls]SHEET1'!$B$2 希望我的回答对你有所帮助。

进入vba编辑器，新添加一个模块，然后粘贴下面的代码. Option Explicit Sub gogo() Dim a$, i&, k& '开始显示文件夹对话框，被选中文件夹下的 'xls文件保存到数组myFiles(1 to i) '注意: 不会搜索子文件夹 Dim fd As FileDialog, myPath$, myFiles$() Set fd = Application.FileDialog(msoFileDialogFolderPicker) With fd k = .Show If k = -1 Then myPath$ = LCase(CStr(.SelectedItems(1))) If Right(myPath, 1) <> "\" Then myPath = myPath & "\" Else Exit Sub End If End With Set fd = Nothing i = 0 a = Dir(myPath & "*.xls") If Len(a) > 0 Then Do Until Len(a) = 0 i = i + 1 ReDim Preserve myFiles(1 To i) myFiles(i) = a a = Dir Loop End If '必须保证每个文件的提取范围 '相同或有相同变化规律，以利于循环提取 Dim Bok1 As Workbook Dim BokX As Workbook Dim Rng As Range Application.ScreenUpdating = False Application.DisplayAlerts = False Set Bok1 = Workbooks.Add For i = LBound(myFiles) To UBound(myFiles) Set BokX = Application.Workbooks.Open(myFiles(i)) '设置提取范围为第一个表的1到3行 Set Rng = BokX.Sheets(1).Rows("1:3") Rng.Copy k = Bok1.Sheets(1).Cells.Range("A65536").End(xlUp).Row Bok1.Activate Bok1.Sheets(1).Cells(k + 1, 1).Select ActiveSheet.Paste BokX.Close savechanges:=False Next Application.CutCopyMode = False Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "数据提取到 " & Bok1.Name Set Rng = Nothing Set Bok1 = Nothing Set BokX = Nothing End Sub