用sql语句合并工作表

Sub 工作表合并()

f = Application.GetOpenFilename(filefilter:="excel文件,*xlsx", Title:="请选择文件", MultiSelect:=True)
If TypeName(f) = "boolean" Then Exit Sub

For i = 1 To UBound(f)
With GetObject(f(i)).Sheets("收发存报表")
lastrow = Range("b1048576").End(xlUp).Row + 1
lastrowpi = .Range("a1048576").End(xlUp).Row
sAddress = GetObject(f(i)).FullName
sAddress1 = .Range("a4:ag" & lastrowpi).Address(0, 0)
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=microsoft.Ace.oledb.12.0;Extended Properties=Excel 12.0;Data Source=" & sAddress
strsql = "select * from [收发存报表$" & sAddress1 & "]"
rs.Open (strsql), cnn
Cells(lastrow, 1).CopyFromRecordset cnn.Execute(strsql)

' For Each Field In rs.Fields
' aa = Field.Name
' [a5].Offset(0, a) = Field.Name
' a = a + 1
' Next
Set rs = Nothing
Set cnn = Nothing
End With

GetObject(f(i)).Close False

Next

 

End Sub