|
具体情况请看附件
Private Sub CommandButton1_Click()
Dim str As String
Dim stri As String
Dim i As Integer
Dim sh As Worksheet
Dim sql As String
Dim objcn As New ADODB.Connection
Range("a2:b65536").ClearContents
Application.ScreenUpdating = False
str = Dir(ActiveWorkbook.Path & "\*.xlsx")
Do
If InStr(1, str, "汇总") = 0 Then
objcn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=Yes';Data Source=" & ThisWorkbook.Path & "\" & str
For Each sh In Worksheets
stri = sh.Name
If sql = "" Then
sql = "select * from [" & stri & "$]"
Else
sql = sql & " union all select * from [" & stri & "$]"
End If
Next
i = [A65536].End(xlUp).Row + 1
Cells(i, 1).CopyFromRecordset objcn.Execute(sql)
objcn.Close
Set objcn = Nothing
End If
str = Dir
Loop Until Len(str) = 0
Application.ScreenUpdating = True
End Sub |
|