|
Sub ADO_多薄首表_合并_无标题行()
Range("A2:Z1048576") = ""
Set conn = CreateObject("adodb.connection")
Path = ThisWorkbook.Path
n = UBound(Split(Path, "\"))
sPath = Replace(Path, Split(Path, "\")(n), "原始文档/")
Fn = Dir(sPath & "*.xls?")
Set Rst = VBA.CreateObject("ADODB.Recordset")
Application.ScreenUpdating = False
Do While Len(Fn)
If InStr(Fn, "0030") = 0 And InStr(Fn, "test") = 0 Then
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;extended Properties='excel 12.0;HDR=no';data source=" & sPath & Fn
SQL = "Select F1,F3 from [A13:C] Where f1=" & Split(Split(ThisWorkbook.Name, ".")(0), "-")(1) & ""
Rst.Open SQL, sConnect, 3, 1
If Not (Rst.BOF And Rst.EOF) Then
Set Rng = Cells(Rows.Count, 1).End(3).Offset(1)
Rng.CopyFromRecordset Rst
End If
Rst.Close
End If
Fn = Dir()
Loop
Application.ScreenUpdating = True
Set Rst = Nothing
Set Rng = Nothing
End Sub
Sub 批量复制文件() ''代码在另一工作薄中使用
Path = ThisWorkbook.Path
For H = 1 To 5
FileCopy Path & "\A-0.xlsm", Path & "\" & Chr(65 + H) & "-" & H & ".xlsm"
Next H
End Sub
|
|