批量从EXCEL中导入到另一个EXCEL表格

chenhui5113

各位大神，麻烦使用VBA一键将附件中的不同的EXCEL文件中的数据导入到另一个EXCEL文件中。

lcluck2002

很好的练习题。先Mark一下！

limonet

代码审核中。

limonet

Sub limonet()
    Dim Path$, FileName$, i%, j$
    Dim Cn As Object, StrSQL$
    Set Cn = CreateObject("adodb.connection")
    Cn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
    Path = ThisWorkbook.Path & "\"
    FileName = Dir(Path & "*.xls")
    Do While FileName <> "" And Not FileName Like "*.xlsm"
        i = i + 1
        j = Split(Split(FileName, "CP_")(1), ".xls")(0)
        StrSQL = "select Actual as " & j & " from [Sheet1$]a left join [excel 12.0;database=" & Path & FileName & "].[Report$A13:F]b ON a.Characteristic=b.Characteristic"
        Cells(1, i + 1) = j
        Cells(2, i + 1).CopyFromRecordset Cn.Execute(StrSQL)
        FileName = Dir
    Loop
End Sub

chenhui5113

limonet 发表于 2023-6-30 14:18
Sub limonet()
    Dim Path$, FileName$, i%, j$
    Dim Cn As Object, StrSQL$

非常好用，谢谢老师，能否注释一下