Dim myRange As the Variant
Dim myArray on
Dim titleRange As Range
Dim the title As a String
Dim columnNum As Integer
MyRange=Application. InputBox (the prompt: "please select a title:"=, Type:=8)
MyArray on=WorksheetFunction. Transpose (myRange)
Set titleRange=Application. InputBox (=prompt: "please select split header, must be the first line, and as a cell, such as:" name ", "Type:=8)
Title=titleRange. Value
ColumnNum=titleRange. Column
Application. ScreenUpdating=False
Application. DisplayAlerts=False
Dim i& Myr& , Arr, num&
Dim d, k
For I=Sheets. Count To 1 Step 1
If Sheets (I). The Name & lt;> "Data source" Then
Sheets (I). The Delete
End the If
Next I
The Set d=CreateObject (" Scripting. The Dictionary ")
Myr=Worksheets (" source "). UsedRange. Rows. Count
Arr=Worksheets (" source "). The Range (Cells (2, columnNum), Cells (Myr, columnNum))
For I=1 To UBound (Arr)
D (Arr (I, 1))=""
Next
K=d.k eys
For I=0 To UBound (k)
Set the conn=CreateObject (" adodb. Connection ")
Conn. Open the provider="Microsoft. Jet. The oledb. 4.0; Extended properties=8.0 excel; Data source="& amp; ThisWorkbook. FullName
Sql="select * from [source $] where" & amp; The title & amp; "='" & amp; K (I) & amp; "'
"
Worksheets. Add after:=Sheets (Sheets. Count)
With ActiveSheet
'With Sheets (Sheets. The Count - 1)
'With Worksheets (Sheets. Count)
'Name=k (I)
For num=1 To UBound (myArray on)
Cells (1, num)=myArray on (num, 1)
Next num
Range (" A2 ") CopyFromRecordset conn. Execute (Sql)
End With
Sheets (1). Select
Sheets (1). Cells. Select
Selection. Copy
Worksheets (Sheets. Count). Activate
ActiveSheet. Cells. Select
Selection. The PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application. CutCopyMode=False
Next I
Conn. Close
Set the conn=Nothing
Application. DisplayAlerts=True
Application. ScreenUpdating=True
End Sub
CodePudding user response:
Dizzy, just some of the code, must give a data available for commissioning, exactly is which line out the problem, then see err. Decrtiption will have the wrong words,