Question

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

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

Answer 1

'将多个工作簿放在同一文件夹下，其中有一个放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

Answer 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

Answer 3

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