提取不同名称工作簿中相同名称表的指定行

hxsjsw

有多个不同名称的工作簿，其中有多个表，表的名称都是固定的几个；想从所有工作簿中提取其中一个工作表中的标题及数据行（不含表头标注部分及表尾标注以下部分），求指教！

ykcbf1100

源数据都没有，你也敢来求助啊。

limonet

关键字：union all+where

limonet

Sub limont()
    Dim Cn As Object, StrSQL$, Path$, FileName$
    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 & "\limonet\"
    FileName = Dir(Path & "*.xlsx")
    Do While FileName <> ""
        StrSQL = StrSQL & " Union All Select * From [Excel 12.0;Database=" & Path & FileName & "].[项目表$A3:M] Where F4<>''"
        FileName = Dir
    Loop
    Range("A2").CopyFromRecordset Cn.Execute(Mid(StrSQL, 12))
End Sub

ykcbf1100

limonet 发表于 2024-4-18 20:18
关键字：union all+where

好人呐，必须点赞

limonet

ykcbf1100 发表于 2024-4-18 20:31
好人呐，必须点赞

,又被你发现了，毫无秘密可言。

ykcbf1100

limonet 发表于 2024-4-18 20:36
,又以被你发现了，毫无秘密可言。

你做好人次数比较多，容易被发现

limonet

ykcbf1100 发表于 2024-4-18 20:37
你做好人次数比较多，容易被发现

尴尬的笑，

ykcbf1100

limonet 发表于 2024-4-18 21:18
尴尬的笑，

你帮人热情比我高，我对于无附件或无源数据的求助一般不出手。

limonet

ykcbf1100 发表于 2024-4-18 21:21
你帮人热情比我高，我对于无附件或无源数据的求助一般不出手。

出手就是大手笔。