下面这段代码可以遍历指定文件夹下所有xls文件

下面这段代码可以遍历指定文件夹下所有xls文件，但：

1.文件夹下的xls文件可以返回到工A列，但子文件夹下的xls文件就不行

2.想同时在B列后能返回xls文件名下的工作表名称

Private Sub CommandButton1_Click()

Dim fn As String

Dim r As Long

fn =Dir(ThisWorkbook.Path & "\*.xls")

While fn <> ""

r = r + 1

Cells(r, 1) = fn

fn = Dir()

Wend

End Sub

Sub 汇总()

Dim sh As Worksheet, FileName As String, rng As Range, sht As Worksheet

Set sht = ActiveSheet

FileName = Dir(ThisWorkbook.Path & "\*.xls") '待汇总文件

Do

If FileName <> Then '如果当前文件不是汇部表，则处理此文件Set rng = sht.Range("A5").End(xlDown) '确定合计最上方的空单元格

If rng = "合计" Then '如果当前单元格是“合计”项

rng.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove '插入空行

Set rng = rng.Offset(-2, 0) '调整单元格的位置

End If

Set sh = Workbooks.Open(ThisWorkbook.Path & "\" & FileName).Worksheets("Sheet1") '打开待汇总文件

rng.Offset(1, 0) = sh.[M4] '填充编号

rng.Offset(1, 1) = sh.[C4] '填充姓名

rng.Offset(1, 2) = sh.[M18] '填充总价

sh.Parent.Close (False) '关闭文件

End If

FileName = Dir() '遍历下一个文件

Loop While FileName <> ""

End Sub

这段小程序就把一个EXCEL文件中每个工作表的A1单元格填上了a

Sub tt()

For i = 1 To ActiveWorkbook.Worksheets.Count

ActiveWorkbook.Worksheets(i).Cells(1, 1).Value = "a"

Next

End Sub

多个格式相同的EXCEL文件合并(每个EXCEL都有多个SHEET),网上找了一代码,修改了下，但还需要进一步处理,可是我不会,所以来这请教高手们了。1:我从第2到第N张表,表头内容就不复制了，但是下面关键代码有错，不知道怎么改,谢谢了。

Workbooks(dirname).Sheets(3).Range("A2", Cells.SpecialCells(xlCellTypeLastCell)).Copy _ Sheets(3).Range("a65536").End(xlUp).Offset(1, 0)

2:还有遍历EXCEL文件家所有SHEET,能不能写成循环呀.

不然

'复制新打开工作簿的第2个工作表的已用区域到当前工作表

Workbooks(dirname).Sheets(2).UsedRange.Copy _

Sheets(2).Range("a65536").End(xlUp).Offset(1, 0) 这段代码导致我有几个SHEET就要写几次,好麻烦呀.....

Sub UnionWorksheets() 大家如果有更好的函数,或者代码能实现多个EXCEL文件数据合并的,也可以贴出.

谢谢大家了。

Dim i As Long ' 循环变量

i = 0

Dim insert_row As Long ' 合并文件中的粘贴位置Application.ScreenUpdating = False

Dim lj As String

Dim dirname As String

Dim nm As String lj = ActiveWorkbook.Path

nm =

dirname = Dir(lj & "\*.xls") Cells.Clear Do While dirname <> ""

If dirname <> nm Then

i = i + 1 Workbooks.Open filename:=lj & "\" & dirname Workbooks(nm).Activate '复制新打开工作簿的第一个工作表的已用区域到当前工作表'大哥们这个能不能写成循环,不然一个sheet来做一次好麻烦呀. Workbooks(dirname).Sheets(1).UsedRange.Copy _

Sheets(1).Range("a65536").End(xlUp).Offset(1, 0)

'复制新打开工作簿的第2个工作表的已用区域到当前工作表

Workbooks(dirname).Sheets(2).UsedRange.Copy _

Sheets(2).Range("a65536").End(xlUp).Offset(1, 0)

'复制新打开工作簿的第3个工作表的已用区域到当前工作表

If i = 1 Then

Workbooks(dirname).Sheets(3).UsedRange.Copy _