|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub test()
Dim f, filename As String
Dim fu(1 To 5)
Dim k, x, i, j As Integer
Dim wb As Workbook
Dim sh As Worksheet
Dim arr
On Error Resume Next
f = ThisWorkbook.Path & "\" '获得文件下需要汇总文件的名称
filename = Dir(f & "*.xlsx")
Do
k = k + 1
fu(k) = filename
filename = Dir
Loop Until filename = ""
For x = 1 To UBound(fu)
If Len(fu(x)) > 3 Then
Set wb = Workbooks.Open(f & fu(x))
End If
For i = 1 To wb.Sheets.Count
j = ThisWorkbook.Sheets("汇总").Range("c65536").End(xlUp).Row + 1
ThisWorkbook.Sheets("汇总").Range("a" & j) = Left(wb.Name, 3)
ThisWorkbook.Sheets("汇总").Range("b" & j) = wb.Sheets(i).Name
wb.Sheets(i).UsedRange.Offset(1, 0).Copy ThisWorkbook.Sheets("汇总").Range("c" & j)
Next i
wb.Close True
Next x
k = Range("c65536").End(xlUp).Row
arr = Range("a4:b" & k)
For x = 1 To UBound(arr)
If arr(x + 1, 1) = "" Then
arr(x + 1, 1) = arr(x, 1)
End If
If arr(x + 1, 2) = "" Then
arr(x + 1, 2) = arr(x, 2)
End If
Next x
Range("a4").Resize(UBound(arr), 2) = arr
End Sub
|
|